bin/fvwm-themes-script.in

   1 #!@PERL@ -w
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16 #
  17
  18 #-----------------------------------------------------------------------------
  19 #     Copyright 2000, Olivier Chapuis
  20 #-----------------------------------------------------------------------------
  21
  22 use strict;
  23 use Getopt::Long;
  24
  25 my $version = '@VERSION@';
  26 my $fvwmVersion = '@FVWM_VERSION@';
  27
  28 my $prefix = $ENV{'prefix'} || '@prefix@';
  29 my $ROOT_PREFIX = $ENV{'ROOT_PREFIX'} || '@ROOT_PREFIX@';
  30 $ROOT_PREFIX = $ENV{'DESTDIR'} if $ENV{'DESTDIR'};
  31 my $datadir = "@datadir@";
  32
  33 my $userHome = $ENV{'HOME'} || "./.";
  34 my $userDir = $ENV{'FVWM_USERDIR'} || "$userHome/.fvwm";
  35 my $currentThemeName = 'current';
  36 my $themesSubDir = 'themes';
  37 my $currentThemeSubDir = "$themesSubDir/$currentThemeName";
  38 my $personalDirName = 'personal';
  39 my $localeDir = "@FT_DATADIR@/locale";
  40
  41 my $scriptName = ($0 =~ m:([^/]+)$:, $1);
  42 my $path = "";
  43 my $command_ls  = 0;
  44 my $lsOptions = "";
  45 my $type = "";
  46 my $item = -1;
  47 my $checkExec = "";
  48 # globalfeel com loop
  49 my $globalFeel = 0;
  50 my $comName = "script";
  51 my $comPid = 0;
  52 # in line doc and script msg
  53 my $inLineDoc = "";
  54 my $lineLength = 70;
  55 my $getMsg = "";
  56 my $lang = "";
  57 # font selector
  58 my $fontOpt = 0;
  59 my $fontFilter = "";
  60 my $fontReset = 0;
  61 my $fontIndex = 0;
  62 my $fontCurrent = "";
  63 my $fontStart = 0;
  64 my $fontOnlyAdjustable = 0;
  65 my $fontInfo = 0;
  66
  67 GetOptions(
  68 #       "help"               => \&showHelp,
  69 #       "version"            => \&showVersion,
  70         "dirs=s"             => \$path,
  71         "ls"                 => \$command_ls,
  72         "ls-opt=s"           => \$lsOptions,
  73         "type:s"             => \$type,
  74         "item=i"             => \$item,
  75         "check-exec=s"       => \$checkExec,
  76         "globalfeel"         => \$globalFeel,
  77         "com-name=s"         => \$comName,
  78         "in-line-doc=s"      => \$inLineDoc,
  79         "line-length=i"      => \$lineLength,
  80         "get-msg=s"          => \$getMsg,
  81         "lang=s"             => \$lang,
  82         "font"               => \$fontOpt,
  83         "font-filter:s"      => \$fontFilter,
  84         "font-reset"         => \$fontReset,
  85         "font-index=s"       => \$fontIndex,
  86         "font-current=s"     => \$fontCurrent,
  87         "font-start"         => \$fontStart,
  88         "font-info"          => \$fontInfo,
  89 ); # || wrongUsage();
  90
  91
  92 if ($globalFeel) {
  93         $comPid = $comName;
  94         $comPid =~ s/script-//;
  95         $comPid = 0 if ($comPid !~ /^\d+$/);
  96         globalFeelComLoop()
  97         # we never return here
  98 }
  99 elsif ($command_ls) {
 100         print
 101                 getDirListing($path, $lsOptions, $item, $type eq "dir", $type eq "file");
 102 }
 103 elsif ($checkExec ne "") {
 104         my $r = checkExecInPath($checkExec);
 105         print "$r\n";
 106 }
 107 elsif ($inLineDoc ne "") {
 108         buildDoc();
 109 }
 110 elsif ($getMsg ne "") {
 111         buildMsg();
 112 }
 113 elsif ($fontOpt) {
 114         buildFontLists();
 115 }
 116 elsif ($fontInfo) {
 117         buildFontInfo();
 118 }
 119 # ----------------------------------------------------------------------------
 120
 121 sub loadFile ($) {
 122         my $fileName = shift;
 123
 124         open(FILE, "<$fileName") || die("Can't open $fileName: [$!]\n");
 125         my $fileContent = join("", <FILE>);
 126         close(FILE) || die("Can't close $fileName: [$!]\n");
 127         return \$fileContent;
 128 }
 129
 130 #----------------------------------------------------------------------------
 131 # For FvwmScript-FontSelector
 132
 133 sub buildFontLists {
 134         my $return = "";
 135         my $list;
 136         my $fontList = [ ];
 137         my $filterLists = { };
 138         my $foudryFromIndex = "";
 139         my $familyFromIndex = "";
 140         my $i = 0;
 141         my $j;
 142         my $prev = "";
 143         my $ffFilter = "-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*";
 144         my @filterList = qw(* * * * * * * * * * * * * *);
 145         my @keys = qw (Weight Slant Width Style PixSize PtSize XRes YRes Spacing
 146                 AvgWidth Charset);
 147         my @allKeys = qw(Foundry Family);
 148         my @filterKeys = qw(Foundry Weight Slant Style PixSize PtSize Width XRes YRes Spacing AvgWidth Charset);
 149         push @allKeys, @keys;
 150         my $key;
 151         my %current;
 152         my %real;
 153         my $realFont = "";
 154         my @s;
 155         my $adjustable = 0;
 156         my $ffHasChanged = 0;
 157         my $tmpFilter = "";
 158         my $ffHasNoMatch = 0;
 159
 160         $fontCurrent = "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*-*"
 161                 if $fontCurrent eq "";
 162         $ffFilter = "-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*";
 163
 164         fontInit($fontList, \$fontFilter, $filterLists);
 165
 166         @s = split('-',$fontCurrent);
 167         $current{'Foundry'} = $s[1];
 168         $current{'Family'} = $s[2];
 169         $current{'Weight'} = $s[3];
 170         $current{'Slant'} = $s[4];
 171         $current{'Width'} = $s[5];
 172         $current{'Style'} = $s[6];
 173         $current{'PixSize'} = $s[7];
 174         $current{'PtSize'} = $s[8];
 175         $current{'XRes'} = $s[9];
 176         $current{'YRes'} = $s[10];
 177         $current{'Spacing'} = $s[11];
 178         $current{'AvgWidth'} = $s[12];
 179         $current{'Charset'} = $s[13] . "-" .$s[14];
 180
 181         $ffFilter =
 182                 "-$current{'Foundry'}-$current{'Family'}-*-*-*-*-*-*-*-*-*-*-*-*";
 183
 184         if ($fontIndex != 0) {
 185                 if (defined $fontList->[$fontIndex-1] &&
 186                                 $fontList->[$fontIndex-1] =~ /^(.+) \((.+)\)$/) {
 187                         $ffFilter = "-$2-$1-*-*-*-*-*-*-*-*-*-*-*-*";
 188                         $current{'Foundry'} = $2;
 189                         $current{'Family'} = $1;
 190                 } else {
 191                         $ffHasNoMatch = 1;
 192                 }
 193         }
 194
 195         # Merge the filter
 196         my @trueFontFilter = split('-',$fontFilter);
 197
 198         for($i = 1; $i < 14; $i++) {
 199                 $current{"$allKeys[$i-1]"} = $trueFontFilter[$i]
 200                         if $trueFontFilter[$i] ne '*';
 201                 $current{"$allKeys[$i-1]"} .= '-' . $trueFontFilter[14]
 202                         if ($i == 13 && $trueFontFilter[$i] ne '*')
 203         }
 204
 205         %real = %current;
 206         my @f2 = split('-',$ffFilter);
 207         my @f3 = split('-',$fontCurrent);
 208         $ffHasChanged = 1 if $current{'Foundry'} ne $f3[1]
 209                 || $current{'Family'} ne $f3[2];
 210         for($i = 0; $i < 15; $i++) {
 211                 my $f = "*";
 212                 $f = $trueFontFilter[$i] if $trueFontFilter[$i] ne '*';
 213                 $f = $f2[$i] if $f2[$i] ne '*';
 214                 $f = $f3[$i] if $f3[$i] ne '*' && $i > 2;
 215                 $filterList[$i] = $f;
 216         }
 217
 218         if ($type =~ /^font-list/) {
 219                 my $tmp = 0;
 220                 my $ff = "$current{'Family'} ($current{'Foundry'})";
 221                 for($i = 0; defined $fontList->[$i] && $tmp == 0; $i++) {
 222                         $tmp = $i+1
 223                                 if $fontList->[$i] eq $ff;
 224                 }
 225                 #$ffHasNoMatch = 1 if ($tmp == 0);
 226                 $tmp = "0" x (3 - length($tmp)) . $tmp;
 227                 $return .= $tmp;
 228                 foreach (@$fontList) { $return .=  $_ . "|" }
 229                 if ($return eq $tmp) {
 230                         $return .= "||No fonts match the filter|"
 231                 }
 232                 $return =~ s/\|$/!/;
 233                 # return also the filter:
 234                 for($i = 1; $i < 14; $i++) {
 235                         $return .= $trueFontFilter[$i];
 236                         $return .= "-" . $trueFontFilter[14] if ($i == 13);
 237                         $return .= "!";
 238                 }
 239         }
 240
 241         if ($type =~ /all-list/) {
 242                 my $k;
 243
 244                 # check consitency if foundry and/or family have changed:
 245                 if ($ffHasChanged) {
 246                         # remove: Spacing Width Slant Weight Charset if font is not found ...
 247                         my @prefKeys = qw(11 5 4 3 13);
 248                         # the size is computed later
 249                         $filterList[7] = '*';
 250                         $j = 0;
 251                         my $notdone = 1;
 252                         while ($notdone) {
 253                                 $tmpFilter = "";
 254                                 for ($k = 1; $k < 15; $k++) {
 255                                         $tmpFilter .= '-' . $filterList[$k];
 256                                 }
 257                                 open(XLS,"xlsfonts -fn '$tmpFilter' 2>/dev/null |") ||
 258                                         ($return = "Impossible to open xlsfont\n");
 259                                 while(<XLS> && $notdone) { $notdone = 0 }
 260                                 close(XLS);
 261                                 if ($notdone) {
 262                                         $filterList[$prefKeys[$j]] = '*'
 263                                                 if $trueFontFilter[$prefKeys[$j]] eq '*';
 264                                         if ($j == 4 && $trueFontFilter[$prefKeys[$j]] eq '*') {
 265                                                                 $filterList[13] = '*';
 266                                                                 $filterList[14] = '*';
 267                                         }
 268                                 }
 269                                 $j++;
 270                                 $notdone = 0 if $j == 5;
 271                         }
 272                 }
 273
 274                 # see if we are ajustable (what follows seems false but this work, I do
 275                 # not know really why :o)
 276                 $tmpFilter = "";
 277                 for ($k = 1; $k < 7; $k++) {
 278                         $tmpFilter .= '-' . $filterList[$k];
 279                 }
 280                 $tmpFilter .= '-0-0-0-0';
 281                 for ($k = 12; $k < 15; $k++) {
 282                         $tmpFilter .= '-' . $filterList[$k];
 283                 }
 284                 open(XLS,"xlsfonts -fn '$tmpFilter' 2>/dev/null |") ||
 285                         ($return = "Impossible to open xlsfont\n");
 286                 while(<XLS> && $adjustable !=2) { $adjustable = 2 }
 287                 close(XLS);
 288
 289                 # now build the lists
 290                 $j = 3;
 291                 foreach $key (@keys) {
 292                         $i = 0;
 293                         $k = 0;
 294                         $tmpFilter = "";
 295                         if ($adjustable == 2 && $fontOnlyAdjustable) {
 296                                 for ($k = 1; $k < 7; $k++) {
 297                                         if ($k == $j) { $tmpFilter .= '-*'; }
 298                                         else { $tmpFilter .= '-' . $filterList[$k]; }
 299                                 }
 300                                 $tmpFilter .= '-0-0-0-0';
 301                                 for ($k = 12; $k < 15; $k++) {
 302                                         $tmpFilter .= '-' . $filterList[$k];
 303                                 }
 304                         } else {
 305                                 for ($k = 1; $k < 15; $k++) {
 306                                         if ($k == $j && $trueFontFilter[$k] eq '*') {
 307                                                 $tmpFilter .= '-*';
 308                                                 if ($key eq "Charset") {
 309                                                         $tmpFilter .= '-*';
 310                                                         $k++;
 311                                                 }
 312                                         }
 313                                         else { $tmpFilter .= '-' . $filterList[$k] }
 314                                 }
 315                         }
 316                         open(XLS,"xlsfonts -fn '$tmpFilter'|") ||
 317                                 ($return = "Impossible to open xlsfont\n");
 318
 319                         $i = 0;
 320                         while(<XLS>) {
 321                                 chomp;
 322                                 @s = split('-',$_);
 323                                 $list->[$i]->{"$key"} = $s[$j];
 324                                 $list->[$i]->{"$key"} .= "-" . $s[$j+1] if $key eq "Charset";
 325                                 $i++;
 326                         }
 327                         close(XLS);
 328                         $j++;
 329                 }
 330
 331                 # now build return
 332                 $j = 3;
 333                 foreach $key (@keys) {
 334                         my @l = ();
 335
 336                         #needed if filter gives no font
 337                         if ($key eq "Charset") {
 338                                 unshift @l, "$trueFontFilter[$j]-$trueFontFilter[$j+1]"
 339                                         if $trueFontFilter[$j] ne '*';
 340                         } else {
 341                                 unshift @l, $trueFontFilter[$j] if $trueFontFilter[$j] ne '*';
 342                         }
 343
 344                         if ($adjustable == 2 && $key eq "PixSize") {
 345                                 @l = qw(4 5 6 7 8 9 10 11 12 13 14 15 16 18 20 22 24 26 28 30
 346                                                   34 40 50 60)
 347                         }
 348                         for($i = 0; defined $list->[$i]->{"$key"}; $i++) {
 349                                 push @l, $list->[$i]->{"$key"}
 350                         }
 351                         if ($key =~ /Size$/ || $key =~ /Res$/ || $key =~ /^AvgWidth$/) {
 352                                 @l = sort {$a <=> $b} @l;
 353                         }
 354                         else {
 355                                 @l = sort @l;
 356                         }
 357
 358                         my @newl = ();
 359                         $prev = "";
 360                         foreach (@l) {
 361                                 next if $_ eq '0';
 362                                 push @newl, $_ if $_ ne $prev;
 363                                 $prev = $_;
 364                         }
 365
 366                         if ($key eq "Charset") {
 367                                 unshift @newl, '*-*' if $trueFontFilter[$j] eq '*';
 368                         } else {
 369                                 unshift @newl, '*' if $trueFontFilter[$j] eq '*';
 370                         }
 371
 372                         # now adjust the index and compute the real font:
 373                         $i = 0;
 374                         my $index = 0;
 375                         my $diff = 1000;
 376                         my $memDiff;
 377                         foreach ($i = 0; defined $newl[$i]; $i++) {
 378                                 $index = $i+1 if $newl[$i] eq $current{"$key"};
 379                                 if ($key eq "PixSize" && $newl[$i] ne '*' &&
 380                                          $current{"$key"} ne '*' &&
 381                                          $diff > abs($newl[$i] - $current{"$key"})) {
 382                                         $index = $i+1;
 383                                         $real{"$key"} =  $newl[$i];
 384                                         $diff =  abs($newl[$i] - $current{"$key"});
 385                                 }
 386                         }
 387                         if ($index eq "0") {
 388                                 $index = "01";
 389                                 $real{"$key"} =  $newl[0];
 390                         }
 391                         $index = "0" . $index if length($index) == 1;
 392
 393                         $return .= $index;
 394
 395                         foreach (@newl) {
 396                                 $return .= $_ . "|";
 397                         }
 398                         $return =~ s/\|$/!/;
 399                         $j++;
 400                 }
 401                 $i = 0;
 402                 foreach (@allKeys) {
 403                         $i++;
 404                         if ($trueFontFilter[$i] eq '*') {
 405                                 $realFont .= $real{"$_"} . "!"
 406                         } else {
 407                                 $realFont .= $trueFontFilter[$i];
 408                                 if ($i == 13) {
 409                                         $realFont .= "-" . $trueFontFilter[$i+1];
 410                                         $i++;
 411                                 }
 412                                 $realFont .= "!";
 413                         }
 414                 }
 415                 $return .= $realFont;
 416                 $return .= $adjustable . "!";
 417                 $return .= $ffHasNoMatch . "!";
 418         }
 419
 420         if ($type =~ /filter-list/) {
 421                 $j = 1;
 422                 foreach $key (@filterKeys) {
 423                         my @l = @{$filterLists->{"$key"}};
 424                         my $index = 0;
 425                         foreach ($i = 0; defined $l[$i]; $i++) {
 426                                 $index = $i+1 if ($l[$i] eq $trueFontFilter[$j] ||
 427                                         $l[$i] eq "$trueFontFilter[13]-$trueFontFilter[14]");
 428                         }
 429                         if ($index eq "0") {
 430                                 $index = "01";
 431                         }
 432                         $index = "0" . $index if length($index) == 1;
 433
 434                         $return .= $index;
 435
 436                         foreach (@l) {
 437                                 $return .= $_ . "|";
 438                         }
 439                         $return =~ s/\|$/!/;
 440                         if ($j == 1) { $j=3; }
 441                         else { $j++; }
 442                 }
 443                 # add dummy stuff:
 444                 $return .= "!misc!fixed!*!*!*!*!*!*!*!*!*!*!*-*!0!0!";
 445
 446         }
 447
 448         #print STDERR $return . "\n";
 449         print $return;
 450         exit 0;
 451 }
 452
 453 # ---------------------------------------
 454
 455 sub fontInit {
 456         my $fontList = shift;
 457         my $fontFilter = shift;
 458         my $filterLists = shift;
 459
 460         my $str = "";
 461         my $oldFontFilter = "";
 462         my $file = "$userDir/.FvwmScript-FontSelector";
 463         my @filterKeys = qw(Foundry Weight Slant Style PixSize PtSize Width XRes YRes Spacing AvgWidth Charset);
 464         #my @filterKeys = qw(Foundry Family Weight Slant Width XRes YRes Spacing Charset);
 465         if (! -f $file || $fontReset) {
 466                 #print STDERR "create RC\n";
 467                 $$fontFilter = $oldFontFilter = "-*-*-*-*-*-*-*-*-*-*-*-*-*-*";
 468                 my $list = myXlsfonts("$$fontFilter");
 469                 my $prev = "";
 470                 my $i;
 471                 for($i = 0; defined $list->[$i]; $i++) {
 472                         my $a = $list->[$i]->{'Family'};
 473                         my $b = $list->[$i]->{'Foundry'};
 474                         my $newFont = $a . " (" . $b . ")";
 475                         push @$fontList, $newFont if $newFont ne $prev;
 476                         $prev = $newFont;
 477                 }
 478                 @$fontList = sort @$fontList;
 479                 my $key;
 480                 foreach $key (@filterKeys) {
 481                         my @l = ();
 482                         my @newl = ();
 483                         for($i = 0; defined $list->[$i]->{"$key"}; $i++) {
 484                                 push @l, $list->[$i]->{"$key"}
 485                         }
 486                         if ($key =~ /Size$/ || $key =~ /Res$/ || $key =~ /^AvgWidth$/) {
 487                                 @l = sort {$a <=> $b} @l;
 488                         }
 489                         else {
 490                                 @l = sort @l;
 491                         }
 492                         foreach (@l) {
 493                                 next if $_ eq '0' || $_ eq '';
 494                                 push @newl, $_ if $_ ne $prev;
 495                                 $prev = $_;
 496                         }
 497                         if ($key eq "Charset") {
 498                                 unshift @newl, '*-*';
 499                         } else {
 500                                 unshift @newl, '*';
 501                         }
 502                         $i = 0;
 503                         foreach (@newl) {
 504                                 $filterLists->{"$key"}->[$i] =  $_;
 505                                 $i++;
 506                         }
 507                 }
 508                 $str = "";
 509                 $str .= "filter=-*-*-*-*-*-*-*-*-*-*-*-*-*-*\n";
 510                 foreach(@$fontList) { $str .= "$_\n"; }
 511                 my $hash;
 512                 foreach $hash (@filterKeys) {
 513                         $str .= "hash=$hash\n";
 514                         for($i=0; defined $filterLists->{"$hash"}->[$i];$i++) {
 515                                 $str .= $filterLists->{"$hash"}->[$i] ."\n";
 516                         }
 517                 }
 518         } else {
 519                 #print STDERR "load RC\n";
 520                 my $c = loadFile($file);
 521                 my @f = split(/\n/,$$c);
 522                 my $hash = "";
 523                 my $i;
 524                 foreach(@f) {
 525                         next if /^\s*\#/;
 526                         if (/^filter=(.+)$/) {
 527                                 $oldFontFilter = $1;
 528                                 next;
 529                         } elsif (/^hash=(.+)$/) {
 530                                 last if ! $type =~ /filter/;
 531                                 $hash = $1;
 532                                 $i = 0;
 533                                 next;
 534                         } elsif ($hash eq "") {
 535                                 push @$fontList, $_;
 536                                 next;
 537                         } else {
 538                                 $filterLists->{"$hash"}->[$i] = $_;
 539                                 $i++;
 540                         }
 541                 }
 542         }
 543
 544         $$fontFilter = $oldFontFilter if ($$fontFilter eq "");
 545
 546         if ($oldFontFilter ne $$fontFilter) {
 547                 #print STDERR "Re create RC\n";
 548                 @$fontList = ();
 549                 my $list = myXlsfonts("$$fontFilter");
 550                 my $prev = "";
 551                 my $i;
 552                 for($i = 0; defined $list->[$i]; $i++) {
 553                         my $a = $list->[$i]->{'Family'};
 554                         my $b = $list->[$i]->{'Foundry'};
 555                         my $newFont = $a . " (" . $b . ")";
 556                         push @$fontList, $newFont if $newFont ne $prev;
 557                         $prev = $newFont;
 558                 }
 559                 @$fontList = sort @$fontList;
 560                 $str = "";
 561                 $str .= "filter=$$fontFilter\n";
 562                 foreach(@$fontList) { $str .= "$_\n"; }
 563                 my $hash;
 564                 foreach $hash (@filterKeys) {
 565                         $str .= "hash=$hash\n";
 566                         for($i=0; defined $filterLists->{"$hash"}->[$i];$i++) {
 567                                 $str .= $filterLists->{"$hash"}->[$i] ."\n";
 568                         }
 569                 }
 570         }
 571
 572         if ($str ne "") { saveToFile($str,$file); }
 573
 574 }
 575 #-----------------------------------------
 576
 577 sub myXlsfonts {
 578         my $filter = shift;
 579         my $list;
 580         my $i = 0;
 581         my @s;
 582
 583         open(XLS,"xlsfonts -fn '$filter'|") ||
 584                 die "Impossible to open xlsfont\n";
 585
 586         while(<XLS>) {
 587                 chomp;
 588                 @s = split('-',$_);
 589                 $list->[$i]->{'Foundry'} = $s[1];
 590                 $list->[$i]->{'Family'} = $s[2];
 591                 $list->[$i]->{'Weight'} = $s[3];
 592                 $list->[$i]->{'Slant'} = $s[4];
 593                 $list->[$i]->{'Width'} = $s[5];
 594                 $list->[$i]->{'Style'} = $s[6];
 595                 $list->[$i]->{'PixSize'} = $s[7];
 596                 $list->[$i]->{'PtSize'} = $s[8];
 597                 $list->[$i]->{'XRes'} = $s[9];
 598                 $list->[$i]->{'YRes'} = $s[10];
 599                 $list->[$i]->{'Spacing'} = $s[11];
 600                 $list->[$i]->{'AvgWidth'} = $s[12];
 601                 $list->[$i]->{'Charset'} = $s[13] . "-" .$s[14];
 602                 $i++;
 603         }
 604         close(XLS);
 605
 606         return $list;
 607 }
 608
 609 # -------------------
 610
 611 sub buildFontInfo {
 612         my $return .= "";
 613         my $obtained = "";
 614
 615         open(XLS,"xlsfonts -fn '$fontCurrent'|") ||
 616                                 ($return = "Impossible to open xlsfont\n");
 617         while(<XLS>) { chomp; $obtained = $_ if $obtained eq ""; }
 618         close(XLS);
 619         open(XLS,"xlsfonts -ll -fn '$obtained'|") ||
 620                                 ($return = "Impossible to open xlsfont\n");
 621         my $count = 1;
 622         my $a;
 623         while(<XLS>) {
 624                 chomp;
 625                 next if !(/^\s*name.+/ || /^\s*[A-Z].+/ || /^\s*$/);
 626                 s/^\s*//;
 627                 s/\s{1}/ /g;
 628                 $return .= $_ . "|" if $count;
 629                 $count = 0 if /^$/;
 630         }
 631         close(XLS);
 632         $return =~ s/\|$//;
 633         print $return . "\n";
 634 }
 635
 636 #----------------------------------------------------------------------------
 637 # build MSG for scripts
 638
 639 sub buildMsg {
 640
 641         $lang = $ENV{'LANG'} if $lang eq "" && $ENV{'LANG'};
 642         my $msgExt = "msg";
 643         #$lang = "en";
 644         #$lang = "ru";
 645         my $return = "";
 646         my $file = "";
 647         $lang = substr($lang, 0, 2);
 648         # check if ja is ok:
 649         if ($lang eq "ja") {
 650                 my $lc_ctype = $ENV{'LC_CTYPE'} || "";
 651                 $lang = "en"
 652                   if (!(system("fvwm-config --supports-multibyte") == 0 &&
 653                                   $lc_ctype =~ /ja/));
 654         }
 655         if ($getMsg =~ /^\//) {
 656                 $file = $getMsg;
 657         }
 658         else {
 659                 $file = "$localeDir/$lang/$getMsg.$msgExt" if ($lang ne "");
 660                 $file = "$localeDir/en/$getMsg.$msgExt" if (! -f $file);
 661         }
 662         if (! -f $file) {
 663                 my $file = "$getMsg.$msgExt";
 664                 print STDERR "[fvwm-themes]: Cannot find localized or default $file\n";
 665                 print "END         0003end\n";
 666                 exit 0;
 667         }
 668
 669         open(MSG, $file) || die "Cannot open the msg for $getMsg: [$!]\n";
 670
 671         while(<MSG>) {
 672                 chomp;
 673                 if (/([A-Za-z0-9]+)\s+\{(.*)\}\s*/) {
 674                         my $id = $1;
 675                         my $msg= $2;
 676                         my $l1 = length($id);
 677                         my $l2 = length($msg) - 1;
 678                         my $l3 = length($l2);
 679                         # illegal line!
 680                         next if $l1 > 12;
 681                         $id = $id . " " x (12 - $l1);
 682                         next if $l2 > 9999;
 683                         $l2 = "0" x (4-$l3) . $l2;
 684                         $return .= $id . $l2 . $msg;
 685                 }
 686         }
 687         print $return . "END         0003end\n";
 688         close(MSG);
 689         exit 0;
 690 }
 691
 692 #----------------------------------------------------------------------------
 693 # build the doc for FvwmScript-Help
 694
 695 # very simple HTML text parser, could be library function
 696 # don't show this code to Mozilla, lynx or w3c developers
 697 sub parseHtml {
 698         my $html = shift;
 699         my $lineLen = shift;
 700
 701         return "" if $lineLen <= 0;
 702
 703         # constants
 704         my $blockIndentLen = 2;  # probably 3 or 4 is better
 705         my $ulPrefix = "* ";
 706         my $olPrefix = "0. ";
 707         my $headerData = [  # <h1> .. <h6>
 708                 # [ $isCentered, $dashChar ]
 709                 [ 1, "-" ],
 710                 [ 1, "=" ],
 711                 [ 0, "-" ],
 712                 [ 0, "=" ],
 713                 [ 0, "." ],
 714                 [ 0, undef ],
 715         ];
 716
 717         # we don't support tag parameters for now, skip them
 718         $html =~ s/<(\w+)(\s+\w+(\s*=\s*([^>\s]*|"[^"]+?"))?)\s*>/<$1>/sg;
 719
 720         #" convert all whitespaces (currently <pre> is not supported)
 721         $html =~ s/\s+/ /sg;
 722
 723         # title may be supported later, so this function may return [title, body]
 724         $html =~ s{
 725                 <(title|javascript|style)> .*? </(title|javascript|style)> \040*
 726         }{
 727                 ""
 728         }sigxe;
 729
 730         $html =~ s{
 731                 # be sgml compliant about comments :-)
 732                 ( < [^>]+? ) -- .+? -- ( [^>]+ > )
 733         }{
 734                 "$1$2"
 735         }sigxe;
 736
 737         # skip non-html tags
 738         $html =~ s/<[!?].*?> *//sg;
 739
 740         # support emphasis; how about *bold* and _underline_?
 741         $html =~ s{
 742                 <em> (.*?) </em>
 743         }{
 744                 qq("$1")
 745         }sigxe;
 746
 747         $html =~ s{
 748                 <blockquote> \040* (.*?) </blockquote> \040*
 749         }{
 750                 my $txt = "\n" . parseHtml($1, $lineLen - $blockIndentLen);
 751                 $txt =~ s/\n/"\n" . (" " x $blockIndentLen)/sge;
 752                 "\n$txt\n";
 753         }sigxe;
 754
 755         $html =~ s{
 756                 <h([1-6])> \040* (.*?) </h\d> \040*
 757         }{
 758                 my ($isCentered, $dashChar) = @{$headerData->[$1 - 1]};
 759                 my $headLine = $2;
 760                 my $dashLine = "";
 761                 $dashLine = ($dashChar x length($headLine)) . "\n" if defined $dashChar;
 762                 if ($isCentered) {
 763                         my $identLen = int(($lineLen - length($headLine)) / 2);
 764                         $identLen = 0 if $identLen < 0;
 765                         $headLine = (" " x $identLen) . $headLine;
 766                         $dashLine = (" " x $identLen) . $dashLine if $dashLine ne "";
 767                 }
 768                 "\n\n$headLine\n$dashLine\n"
 769         }sigxe;
 770
 771         # supporting a bad html is not guaranteed (<li> without <ul>)
 772         my $listLevel = 0;
 773         my $listItemPrefixes = [ ];
 774
 775         # handle tags
 776         $html =~ s{
 777                 <(/?\w*)> \040*
 778         }{
 779                 if ($1 eq "p") { "\n\n" }
 780                 elsif ($1 eq "br") { "\n" }
 781                 elsif ($1 eq "ul") { $listItemPrefixes->[$listLevel++] = $ulPrefix; "\n" }
 782                 elsif ($1 eq "/ul") { $listLevel-- if $listLevel > 0; "\n\n" }
 783                 elsif ($1 eq "ol") { $listItemPrefixes->[$listLevel++] = $olPrefix; "\n" }
 784                 elsif ($1 eq "/ul") { $listLevel-- if $listLevel > 0; "\n\n" }
 785                 elsif ($1 eq "li") {
 786                         my $ident = " " x ($listLevel * $blockIndentLen);
 787                         if ($listItemPrefixes->[$listLevel - 1] =~ /^(\d+)(.*)$/) {
 788                                 $listItemPrefixes->[$listLevel - 1] = ($1 + 1) . $2;
 789                         }
 790                         my $prefix = $listItemPrefixes->[$listLevel - 1];
 791                         "\n$ident$prefix"
 792                 }
 793                 else { "" }
 794         }sigxe;
 795
 796         # don't support more than 2 new-lines
 797         $html =~ s/\n{3,}/\n\n/sg;
 798         $html =~ s/^\n{2,}/\n/s;
 799
 800         # split long lines to shorter ones
 801         $html =~ s{^(.*)$}{
 802                 my $line = $1;
 803                 my $formatted = "";
 804                 my $totalLen;
 805                 while (($totalLen = length($line)) > $lineLen) {
 806                         my $i = $lineLen;
 807                         while ($i >= 0 && substr($line, $i, 1) ne " ") { $i-- }
 808                         $i = $lineLen if $i < 0;  # give up, split a word
 809                         $formatted .= substr($line, 0, $i) . "\n";
 810                         $line = substr($line, $i, $totalLen);
 811                         $line =~ s/^\s+//;
 812                 }
 813                 "$formatted$line"
 814         }mge;
 815
 816         return $html;
 817 }
 818
 819 sub buildDoc {
 820         $lang = $ENV{'LANG'} if $lang eq "";
 821         $lang = substr($lang, 0, 2);
 822         my $fileExt = "html";
 823         # migo: actually, I think that in a proper system, "fixed" alias already
 824         # points to localized font, but this may be good to support any --lang.
 825         # This info may be read from locale/LANG/fonts.cfg probably.
 826         my %fixedFont = (
 827                 'en' => "-*-fixed-medium-r-semicondensed-*-13-*",
 828                 'ru' => "-cronyx-fixed-medium-r-semicondensed--*-*-*-*-*-*-koi8-*",
 829         );
 830         my $fontLang = exists $fixedFont{$lang}? $lang: 'en';
 831
 832         my $file;
 833         if ($inLineDoc =~ /^\//) {
 834                 $file = $inLineDoc;
 835         } else {
 836                 $file = "$localeDir/$lang/$inLineDoc.$fileExt";
 837                 if (! -f $file) {
 838                         $file = "$localeDir/en/$inLineDoc.$fileExt" unless -f $file;
 839                         $fontLang = "en";
 840                 }
 841         }
 842
 843         if (! -f $file) {
 844                 print "|Documentation is not found...\n";
 845                 exit(0);
 846         }
 847
 848         print $fixedFont{"$fontLang"} . "|";
 849
 850         my $contentRef = loadFile($file);
 851         my $parsedText = parseHtml($$contentRef, $lineLength);
 852
 853         print join("|", split("\n", $parsedText)) . "\n";
 854         exit(0);
 855 }
 856
 857 # this function should be removed later
 858 sub old_buildDoc {
 859
 860         $lang = $ENV{'LANG'} if $lang eq "";
 861         my $txtExt = "txt";
 862         #$lang = "en";
 863         #$lang = "ru";
 864         my $doc = "";
 865         my $file = "";
 866         $lang = substr($lang,0,2);
 867         if ($inLineDoc =~ /^\//) {
 868                 $file = $inLineDoc;
 869         }
 870         else {
 871                 $file = "$localeDir/$lang/$inLineDoc.$txtExt";
 872                 $file = "$localeDir/C/$inLineDoc.$txtExt" if (! -f $file);
 873                 $file = "$localeDir/en/$inLineDoc.$txtExt" if (! -f $file);
 874         }
 875         if (! -f $file) {
 876                 print "Documentation in progress ...";
 877                 exit 0;
 878         }
 879         #$doc = `fmt -w $lineLength $file`;
 880         #$doc =~ s/\n/|/g;
 881         #print $doc;
 882         open(DOC,"$file") || die "cannot open the doc for $inLineDoc";
 883         my $l = 0;
 884         my $inVerb = 0;
 885         my $previousWasBlanc = 0;
 886
 887         while(<DOC>) {
 888                 next if /^\#/;
 889                 chomp;
 890                 my $line = $_;
 891
 892                 if ($line =~ /^<verb>/) {
 893                         $inVerb = 1;
 894                         $doc .= "|" if $doc !~ /\|$/ || $previousWasBlanc;
 895                         next;
 896                 }
 897                 if ($line =~ /^<\/verb>/) {
 898                         $inVerb = 0;
 899                         $previousWasBlanc = 1;
 900                         next;
 901                 }
 902                 if ($inVerb) {
 903                         $doc .= $line . "|";
 904                         next;
 905                 }
 906
 907                 next if ($line =~ /^<abstract>/ || $line =~ /^<\/abstract>/);
 908
 909                 if ($line =~ /^<title>/ || $line =~ /^<sec>/)  {
 910                         my $type = "t";
 911                         $type = "s" if $line =~ /^<sec>/;
 912                         $line =~ s/^<title>\s*//;
 913                         $line =~ s/^<sec>\s*//;
 914                         $line =~ s/\s+$//;
 915                         $l = length($line);
 916                         my $t = 0;
 917                         if ($type eq "t") {
 918                                 $t = int (($lineLength - $l) / 2);
 919                                 $t = 0 if $t <= -1;
 920                         }
 921                         $doc .= "|" if $doc !~ /\|$/ || $previousWasBlanc;
 922                         $doc .= " "x$t . $line . "|" . " "x$t . "-"x$l ."|";
 923                         $l = 0;
 924                         $previousWasBlanc = 1;
 925                         next;
 926                 }
 927
 928                 if ($line =~ /^\s*$/) {
 929                         $l = 0;
 930                         if ($doc !~ /\|$/) {
 931                                 $doc .= "|";
 932                         }
 933                         $doc .= "|" if ($previousWasBlanc);
 934                         $previousWasBlanc = 1;
 935                         next;
 936                 }
 937
 938                 $previousWasBlanc = 0;
 939                 $line =~ s/\s+$//;
 940                 #my $space = substr($line,0,index($line," ")+1);
 941                 $line =~ s/^\s+//;
 942                 my $cl = length($line);
 943                 if ($cl + $l <= $lineLength) {
 944                 $doc .= " " if $doc !~ /\|$/;
 945                         $doc .= $line;
 946                         $l = $cl + $l;
 947                         next;
 948                 }
 949                 my @larray = split(" ",$line);
 950
 951                 foreach (@larray) {
 952                         my $wl = length($_);
 953                         if ($wl + $l + 1 <= $lineLength) {
 954                                 $doc .= " " if $doc !~ /\|$/;
 955                                 $doc .= $_;
 956                                 $l = $wl + $l + 1
 957                         } else {
 958                                 $doc .= "|$_";
 959                                 $l = $wl;
 960                         }
 961                 }
 962         }
 963         close(DOC);
 964         #$doc =~ s/\|/\n/g;
 965         print $doc . "\n";
 966
 967         exit 0;
 968
 969 }
 970
 971 #----------------------------------------------------------------------------
 972
 973 sub getDirListing {
 974         my ($path, $lsOptions, $index, $dirsOnly, $filesOnly) = @_;
 975
 976         if ($path eq "PATH") { $path = $ENV{'PATH'} || '/bin'; }
 977         my @dirList = grep { $_ && -d $_ } split(':', $path);
 978         return "No such directory:|$path\n" unless @dirList;
 979
 980         my @dirs = ();
 981         my @files = ();
 982         my $dir;
 983         foreach $dir (@dirList) {
 984                 open(LSPROC, "ls $lsOptions '$dir' |");  # pipe implies ls -1
 985                 while (<LSPROC>) {
 986                         chomp;
 987                         my $test = $_;
 988                         $test =~ s/[@*\/=|]$// if $lsOptions =~ /F|--classify/;
 989                         #s/[@*\/=|]$// if $lsOptions =~ /F|--classify/ && $index > 0;
 990                         if (-d "$dir/$test") { push @dirs, $_; }
 991                         else { push @files, $_; }
 992                 }
 993                 close(LSPROC);
 994         }
 995
 996         if (@dirList) { @dirs = sort(@dirs); @files = sort(@files); }
 997         my @items = ($dirsOnly? @dirs: $filesOnly? @files: (@dirs, @files));
 998
 999         $items[$index - 1] =~ s/[@*\/=|]$//
1000                 if $lsOptions =~ /F|--classify/ && $index > 0;
1001
1002         return ($index > 0? $items[$index - 1]: join("|", @items)) . "\n";
1003 }
1004
1005
1006 sub checkExecInPath {
1007         my($app) = @_;
1008         my @pathDirs = split(':',$ENV{PATH});
1009         my $dir ="";
1010         foreach $dir (@pathDirs) {
1011                 if ( -x "$dir/$app" ) { return 1 }
1012         }
1013         return 0;
1014 }
1015
1016 #----------------------------------------------------------------------------
1017 #
1018 # the global feel com loop
1019 #
1020 #----------------------------------------------------------------------------
1021
1022 sub globalFeelComLoop {
1023         my $outFifo = ".tmp-com-out-" . $comName;
1024         my $inFifo = ".tmp-com-in-"  . $comName;
1025         my $lockFifo = ".tmp-com-lock-" . $comName;
1026         my $command = "";
1027         my $return = "";
1028
1029         my @components = ("globalfeel");
1030
1031         # "files" and "script" config
1032         my $lastBuild = "";
1033         my $lastHardRead = "";
1034         my $lastComp = "";
1035         my $saveState = { };
1036         my $hardRead = { };
1037
1038         # "themes" config init
1039         my $personalThemes = [ ];
1040         $personalThemes->[0] = "personal";
1041         my $themesConfig = { };
1042         my $currentConfig = { };
1043         my $optConfig = { };
1044
1045         # set up default
1046         foreach (@components) {
1047                 $saveState->{$_}->{'file'} = "$userDir/$themesSubDir/personal/$_";
1048                 $saveState->{$_}->{'theme'} = "personal";
1049                 $hardRead->{$_} = "";
1050                 $currentConfig->{$_} = "default";
1051         }
1052
1053         # get "themes" config
1054         getThemesConfig($personalThemes,$themesConfig,$currentConfig,
1055                 $optConfig,$hardRead);
1056         my $tmp;
1057         foreach $tmp (@components) {
1058                 foreach (@$personalThemes) {
1059                         if (defined $currentConfig->{$tmp} && $currentConfig->{$tmp} eq $_) {
1060                                 $saveState->{$tmp}->{'file'} = "$userDir/$themesSubDir/$_/$tmp";
1061                                 $saveState->{$tmp}->{'theme'} = "$_";
1062                         }
1063                 }
1064         }
1065
1066         # X info:
1067         my      ($redMask,$greenMask,$blueMask) = getXdpyInfo();
1068         # persistante fvwm Config:
1069         my $internalConfig = { };
1070
1071         chdir($userDir) || die "No FvwmConfigHome $userDir";
1072         unlink($lockFifo);
1073         unlink($inFifo);
1074         myMakeFifo($lockFifo);
1075
1076         while(1) {
1077
1078                 eval {
1079                         local $SIG{ALRM} = \&checkScript;
1080                         alarm(10);
1081                         # block until com want to communicate
1082                         open(LOCK,">$lockFifo") || die "cannot write fifo $lockFifo";
1083                         alarm(0);
1084                         close(LOCK);
1085                 };
1086                 if ($@ =~ /^cannot/) {
1087                         print STDERR "$comName: cannot write fifo $lockFifo\n";
1088                         unlink("$lockFifo");
1089                         exit(1);
1090                 }
1091                 if ($@ =~ /^NoScript/) {
1092                         print STDERR "$comName: No more FvwmScript-ConfigCenter: exit!\n";
1093                         unlink("$lockFifo");
1094                         exit(0);
1095                 }
1096                 if ($@ =~ /^Script/) {
1097                         next;
1098                 }
1099                 # read the command.
1100                 eval {
1101                         local $SIG{ALRM} = sub { die "Timeout" };
1102                         alarm(10);
1103                         # block unless com is ready to write on $outFifo
1104                         open(IN,"$outFifo") || die "cannot open $outFifo";
1105                         alarm(0);
1106                         ($command)=(<IN>);
1107                         close(IN);
1108                 };
1109                 if ($@ =~ /^cannot/) {
1110                         print STDERR "$comName: cannot read fifo $outFifo\n";
1111                         unlink($lockFifo);
1112                         exit(1);
1113                 }
1114                 if ($@ =~ /^Timeout/) {
1115                         print STDERR "$comName: com give an unvalide unlock!\n";
1116                         next;
1117                 }
1118                 #print STDERR "msg com 2\n";
1119                 #------------------------------------------------------------------------
1120                 # build the answer
1121                 chomp($command);
1122                 my $return = "";
1123                 #-----------------------------------
1124                 if ($command eq "get-perso-themes") {
1125                         foreach (@$personalThemes) {
1126                                 $return .= "$_|";
1127                         }
1128                         $return =~ s/\|$//;
1129                 }
1130                 #-----------------------------------
1131                 elsif ($command =~ /^get-themes-info\s+(.+)$/) {
1132                         my $comp = $1;
1133                         $return .= "$saveState->{$comp}->{'theme'}\n";
1134                         $return .= "$currentConfig->{$comp}\n";
1135                         my $compCfg = $themesConfig->{$comp};
1136                         my $themesList = "";
1137                         my $k;
1138                         foreach $k (sort keys %$compCfg) {
1139                                 $themesList .= "$k|";
1140                         }
1141                         $themesList =~ s/\|$//;
1142                         $return .= "$themesList\n";
1143                         my $options = $optConfig->{$comp};
1144                         my $opt;
1145                         if (ref($options) eq 'ARRAY') {
1146                                 foreach $opt (@$options) {
1147                                         $return .= "$opt->{'current'}\n";
1148                                 }
1149                         }
1150                 }
1151                 #--------------------------------------------------------
1152                 elsif ($command =~ /^get-config\s+(.+)\s+(.+)\s+(.+)$/) {
1153                         my $theme = $1;
1154                         my $comp = $2;
1155                         my $whichPart = $3;
1156                         my @list = ();
1157                         if ($comp eq "All") {
1158                                 @list = @components;
1159                                 $whichPart = "All";
1160                         } else {
1161                                 @list = ("$comp");
1162                         }
1163                         my $ct;
1164                         foreach $ct (@list) {
1165                                 my $t = "";
1166                                 my $themeshash = $themesConfig->{$ct};
1167                                 if ($theme eq "current") {
1168                                         $t = $currentConfig->{$ct};
1169                                 }
1170                                 elsif ($theme =~ /^\d+$/) {
1171                                         my $i = 1;
1172                                         foreach (sort keys %$themeshash) {
1173                                                 $t = $_  if $i == $theme;
1174                                                 $i++;
1175                                         }
1176                                 }
1177                                 else { $t = $theme; }
1178                                 my $file;
1179                                 $file = $themeshash->{$t}->{'file'};
1180                                 if (defined $file && -f $file) {
1181                                         my $parseFunc = "parse_" . $ct . "_Config";
1182                                         my $configForScript = { };
1183                                         my $keys = [ ];
1184                                         #print STDERR "$file, $theme, $ct\n";
1185                                         my $error = eval {
1186                                                 no strict 'refs';
1187                                                 $parseFunc->($file,$configForScript,$keys,
1188                                                         $internalConfig,$optConfig->{$ct});
1189                                         };
1190                                         $error = "Internal: $@" if $@;
1191                                         $return .= "$error\n";
1192                                         foreach (@$keys) {
1193                                                 $return .= "$configForScript->{$_}"
1194                                                         if $_ eq $whichPart || $whichPart eq "All";
1195                                         }
1196                                 }
1197                                 else {
1198                                         $return = "config file for $ct\@$t not found!";
1199                                 }
1200                                 $return .= "\n";
1201                         }
1202                 }
1203                 #-------------------------------------------------------------
1204                 elsif ($command eq "get-preferences") {
1205                         $return = get_globalfeel_Preferences();
1206                 }
1207                 #-------------------------------------------------------------
1208                 elsif ($command =~ /^save-try-config\s+([A-Za-z0-9]+)\s+([A-Za-z0-9]+)\s+(\d)\s+(.+)$/) {
1209                         my $comp = $1;
1210                         my $whichPart = $2;
1211                         my $configFromScript = $4;
1212                         my $how = $3; # 0: check, 1: try, 2:save, 3: try and save
1213                         my $buildFunc = "build_" . $comp . "_Config";
1214                         my $fvwmConfig = { };
1215                         my $error = { };
1216                         my $keys = [ ];
1217                         eval {
1218                                 no strict 'refs';
1219                                 $buildFunc->($configFromScript,$fvwmConfig,$error,$keys);
1220                         };
1221                         my $err = $@ ? "Internal: $@|" : "";
1222                         $err .= "$error->{All}|"
1223                                 if defined $error->{'All'} && $error->{'All'} ne "";
1224                         foreach (@$keys) {
1225                                 $err .= "$error->{$_}|"
1226                                         if defined $error->{$_} && $error->{$_} ne "" &&
1227                                                 ($_ eq $whichPart || $whichPart eq "All");
1228                         }
1229                         $err =~ s/\|$//;
1230                         $err = "ok" if $err eq "";
1231                         $lastHardRead = $hardRead->{$comp};
1232                         $lastComp = $comp;
1233                         $lastBuild = "";
1234                         foreach (@$keys) {
1235                                 $lastBuild .= "$fvwmConfig->{$_}";
1236                         }
1237                         $lastHardRead = $hardRead->{$comp};
1238                         if ($how == 0) {
1239                                 $return = $err;
1240                         }
1241                         if ($how == 1 || $how == 3) {
1242                                 $return = $lastBuild;
1243                         }
1244                         if ($how == 2 || $how == 3) {
1245                                 saveToFile($lastBuild,$saveState->{$comp}->{'file'});
1246                                 my $theme = $saveState->{$lastComp}->{'theme'};
1247                                 system("fvwm-themes-config --load $lastComp\@$theme &");
1248                         }
1249
1250                 }
1251                 #---------------------------------------------------
1252                 elsif ($command =~ /^save-try-last-build\s+(\d)$/) {
1253                         my $how = $1;
1254                         if ($how == 1 || $how == 3) {
1255                                 $return = $lastBuild . $lastHardRead;
1256                         }
1257                         if ($how == 2 || $how == 3) {
1258                                 saveToFile($lastBuild,$saveState->{$lastComp}->{'file'});
1259                                 my $theme = $saveState->{$lastComp}->{'theme'};
1260                                 system("fvwm-themes-config --load $lastComp\@$theme &");
1261                         }
1262                 }
1263                 # ---------------------------------------------------
1264                 elsif ($command =~ /^set-save-file\s+(.+)\s+(\d+)$/) {
1265                         my $comp = $1;
1266                         my $i = $2;
1267                         $return = $personalThemes->[$i-1];
1268                         $saveState->{$comp}->{'file'} =
1269                                 "$userDir/$themesSubDir/$return/$comp";
1270                         $saveState->{$comp}->{'theme'} = $return;
1271                 }
1272                 # ---------------------------------------------------
1273                 elsif ($command =~ /^hexcolor-2-value\s+\#([a-fA-F0-9][a-fA-F0-9])([a-fA-F0-9][a-fA-F0-9])([a-fA-F0-9][a-fA-F0-9])$/) {
1274                         my $r = hex($1);
1275                         my $g = hex($2);
1276                         my $b = hex($3);
1277                         if ($redMask*$greenMask*$blueMask != 0) {
1278                                 $b = int( $b * ($blueMask+1) / 256);
1279                                 $g = $g * ( (1+($greenMask/($blueMask+1))) / 256 );
1280                                 $g = int($g) * ($blueMask + 1);
1281                                 #$r = int( $r * $redMask / 255 );
1282                                 $r = $r * ( (1+($redMask/($greenMask+$blueMask+1)))  / 256 );
1283                                 $r = int($r) * ($greenMask + $blueMask + 1);
1284                                 $return = $r + $g +$b;
1285                                 $return = 1 if $return == 0;
1286                         }
1287                 }
1288                 # ---------------------------------------------------
1289                 elsif ($command =~ /^value-2-hexcolor\s+(.*)$/) {
1290                         my $d = $1;
1291
1292                         $return = 0;
1293                         if ($d =~ /^\d+/ && $redMask*$greenMask*$blueMask != 0) {
1294                                 my ($r,$g,$b) = (0, 0, 0);
1295                                 $r = int ( $d / ($greenMask + $blueMask + 1));
1296                                 $d = $d - $r * ($greenMask + $blueMask + 1);
1297                                 $r = int( $r*255 / ($redMask/($greenMask + $blueMask + 1)) );
1298                                 $g = int ( $d / ($blueMask + 1));
1299                                 $d = $d - $g * ($blueMask + 1);
1300                                 $g =  int ( $g*255 / ($greenMask/($blueMask + 1)) );
1301                                 $b = int ( $d*255 / $blueMask );
1302                                 $r = 255 if $r > 255;
1303                                 $g = 255 if $g > 255;
1304                                 $b = 255 if $b > 255;
1305                                 $return = "#". int2hex($r) . int2hex($g) . int2hex($b);
1306                         }
1307                 }
1308                 # --------------------------
1309                 elsif ($command =~ /^save-preferences\s+(\d+)(\d+)(\d+)$/) {
1310                         my $pref = "TryIsGlobal=$1\nDefaultIsGlobal=$2\nSaveIsGlobal=$3\n";
1311                         saveToFile($pref,"$userDir/.FvwmScript-GlobalFeel");
1312                 }
1313                 # --------------------------
1314                 elsif ($command eq "exit") {
1315                         unlink($lockFifo);
1316                         exit(0);
1317                 }
1318                 else {
1319                         print STDERR "$comName: unknown command $command\n";
1320                         $return = "0";
1321                 }
1322                 #------------------------------------------------------------------------
1323                 # answer
1324                 myMakeFifo($inFifo);
1325                 eval {
1326                         local $SIG{ALRM} = sub { die "Timeout" };
1327                         alarm(10);
1328                         # this line block until com take the answer
1329                         open(OUT,">$inFifo") || die "cannot write fifo $inFifo";
1330                         alarm(0);
1331                         print OUT "ok\n" . $return;
1332                         close(OUT);
1333                         unlink($inFifo);
1334                 };
1335                 if ($@ =~ /cannot/) {
1336                         print STDERR "$comName: cannot write on fifo $inFifo\n";
1337                         unlink($lockFifo);
1338                         unlink($inFifo);
1339                         exit(1);
1340                 }
1341                 if ($@ =~ /Timeout/) {
1342                         print STDERR "$comName: com do not read my answer!\n";
1343                 }
1344         }
1345 }
1346
1347 #----------------------------------------------------------------------------
1348 # An alarm handler (called from eval block):
1349 sub checkScript {
1350
1351         die "Script" unless ($comPid);
1352
1353         my $test = 0;
1354         my $lockFifo = ".tmp-com-lock-" . $comName;
1355
1356         $test = 1 if kill 0 => $comPid;
1357
1358         if ($test) { die "Script"; }
1359         else { unlink($lockFifo) if -p "$lockFifo"; die "NoScript"; }
1360 }
1361
1362 #-----------------------------------------------------------------------------
1363 #
1364 sub myMakeFifo {
1365         my ($fifo) = @_;
1366         system("mkfifo '$fifo'");  # not portable: mknod '$fifo' p
1367 }
1368
1369 #-----------------------------------------------------------------------------
1370 # For killing FvwmScript-ConfigCenter if an error happen in this script!
1371 END {
1372         if ($globalFeel) {
1373                 if ($?) {
1374                         my $lockFifo = ".tmp-com-lock-" . $comName;
1375                         my $inFifo = ".tmp-com-in-" . $comName;
1376                         my $message = "fvwm-themes-script: internal error $?\n";
1377                         # actually $@ is never defined in END
1378                         $message .= "\teval error: $@\n" if $@;
1379                         $message .= "\tOS error: $!\n" if $!;
1380                         # actually the following is never executed on unix
1381                         $message .= "\tOS error 2: $^E\n" if $^E && !($! && $^E eq $!);
1382
1383                         unlink($lockFifo) if -p "$lockFifo";
1384                         unlink($inFifo) if -p "$lockFifo";
1385                         if ($comPid) {
1386                                 kill(9, $comPid);
1387                                 $message .= "\tkilling FvwmScript-ConfigCenter";
1388                         }
1389                         print STDERR "$message\n";
1390                 }
1391         }
1392 }
1393
1394 # -----------------------------------------------------------------------------
1395 # get the themes info from fvwm-themes-config
1396
1397 sub getThemesConfig {
1398         my $personalThemes = shift;
1399         my $themesConfig = shift;
1400         my $currentConfig = shift;
1401         my $optConfig = shift;
1402         my $hardRead = shift;
1403
1404         my $in = `fvwm-themes-config --config-center`;
1405         chomp($in);
1406         my @input = split(/\n/, $in);
1407         my $i = 0;
1408         my $j = 0;
1409         my $k = 1;
1410         my $comp = "";
1411         my $theme = "";
1412         my $inHardRead = 1;
1413         my $inOptions = 0;
1414         my $o = 0;
1415         while(defined $input[$i]) {
1416                 if ($input[$i] =~ /^configuration of (.+) for the Config Center$/) {
1417                         $comp = $1;
1418                         $j = 0;
1419                         $i++;
1420                         next
1421                 }
1422                 if ($inHardRead) {
1423                         if ($input[$i] =~ /END/) { $inHardRead = 0 }
1424                         else { $hardRead->{'globalfeel'} .= "$input[$i]\n" }
1425                         $i++;
1426                         next
1427                 }
1428                 if ($input[$i] =~ /^OPTIONS/) {
1429                         $inOptions = 1;
1430                         $i++;
1431                         $o = 0;
1432                         next;
1433                 }
1434                 if ($inOptions) {
1435                         if ($input[$i] =~ /^END/) { $inOptions = 0 }
1436                         else {
1437                                 my ($tmp1,$tmp2) = split (":",$input[$i]);
1438                                 $optConfig->{$comp}->[$o]->{'file'} = $tmp1;
1439                                 $optConfig->{$comp}->[$o]->{'current'} = $tmp2;
1440                                 $o++;
1441                         }
1442                         $i++;
1443                         next;
1444                 }
1445                 if ($comp eq "") {
1446                         if ($input[$i] ne "personal") {
1447                                 $personalThemes->[$k] = $input[$i];
1448                                 $k++;
1449                         }
1450                         $i++;
1451                         next
1452                 }
1453                 if ($j == 0) {
1454                         $currentConfig->{$comp} = $input[$i];
1455                         $j++; $i++;
1456                         next
1457                 }
1458                 elsif ($j == 1) {
1459                         $theme = $input[$i];
1460                         $j=2; $i++;
1461                         next
1462                 }
1463                 elsif ($j == 2) {
1464                         $themesConfig->{$comp}->{$theme}->{'file'} = "$input[$i]";
1465                         $j=1; $i++;
1466                         next
1467                 }
1468                 $i++;
1469         }
1470 }
1471
1472 #----------------------------------------------------------------------------
1473 # get the globalfeel preferences
1474
1475 sub get_globalfeel_Preferences {
1476         my $file = "$userDir/.FvwmScript-GlobalFeel";
1477
1478         return "000" if (! -f $file);
1479
1480         my $tryIsGlobal = 0;
1481         my $defaultIsGlobal = 0;
1482         my $saveIsGlobal = 0;
1483
1484         open(FILE,"$file");
1485         while(<FILE>) {
1486                 if ($_ =~ /^TryIsGlobal=(\d+)$/) {
1487                         $tryIsGlobal = $1;
1488                 }
1489                 elsif ($_ =~ /^DefaultIsGlobal=(\d+)$/) {
1490                         $defaultIsGlobal = $1;
1491                 }
1492                 elsif ($_ =~ /^SaveIsGlobal=(\d+)$/) {
1493                         $saveIsGlobal = $1;
1494                 }
1495         }
1496         close(FILE);
1497         return "$tryIsGlobal$defaultIsGlobal$saveIsGlobal";
1498 }
1499
1500 #----------------------------------------------------------------------------
1501 # build globalfeel from a sequence
1502
1503 sub  build_globalfeel_Config {
1504         my $configFromScript = shift;
1505         my $fvwmConfig = shift;
1506         my $err = shift;
1507         my $keys = shift;
1508         my $index = 0;
1509         my @list = ();
1510         my ($tmp,$tmp2,$hide,$x,$y);
1511         my $impossible = "An Impossible error happen, GASP!";
1512
1513         @$keys = ("Focus", "Move", "Paging", "Transient", "Hints");
1514
1515         # check for the good number of "!"
1516         my @test = split(/!/,$configFromScript);
1517         if ($#test != 12) {
1518                 $err->{'All'} =
1519                         "Why do you enter a ! in a field where you have to enter numbers? ($#test)|";
1520         }
1521
1522         # -------------------------------------------- Focus
1523         $fvwmConfig->{'Focus'} .=
1524                 "\n# -------------------------- Focus and Placement ".
1525                 "--------------------------\n\n";
1526         $tmp = substr($configFromScript,$index,1);
1527         if ($tmp == 1) { $fvwmConfig->{'Focus'} .= "Style * ClickToFocus" }
1528         elsif ($tmp == 2) { $fvwmConfig->{'Focus'} .= "Style * MouseFocus" }
1529         elsif ($tmp == 3) { $fvwmConfig->{'Focus'} .= "Style * SloppyFocus" }
1530         else { $err->{'Focus'} .= "$impossible|" }
1531         #
1532         $index++;
1533         $tmp = substr($configFromScript,$index,1);
1534         if ($tmp == 1) { $fvwmConfig->{'Focus'} .= ", ClickToFocusPassesClick" }
1535         elsif ($tmp == 0) { $fvwmConfig->{'Focus'} .= ", ClickToFocusPassesClickOff"}
1536         else { $err->{'Focus'} .= "$impossible|" }
1537         #
1538         $index++;
1539         $tmp = substr($configFromScript,$index,1);
1540         if ($tmp == 1) {
1541                 $fvwmConfig->{'Focus'} .= ", ClickToFocusRaises, MouseFocusClickRaises"
1542         }
1543         elsif ($tmp == 0) {
1544                 $fvwmConfig->{'Focus'} .=
1545                         ", ClickToFocusRaisesOff, MouseFocusClickRaisesOff"
1546         }
1547         else { $err->{'Focus'} .= "$impossible|" }
1548         $fvwmConfig->{'Focus'} .= "\n";
1549         #
1550         $index++;
1551         $tmp = substr($configFromScript,$index,1);
1552         if ($tmp == 1) { $fvwmConfig->{'Focus'} .= "ColormapFocus FollowsFocus\n" }
1553         elsif ($tmp == 0) { $fvwmConfig->{'Focus'} .= "ColormapFocus FollowsMouse\n"}
1554         else { $err->{'Focus'} .= "$impossible|" }
1555         #
1556         $index++;
1557         $tmp = substr($configFromScript,$index,1);
1558         if ($tmp == 1) {
1559                 $fvwmConfig->{'Focus'} .=
1560                         "Style * TileCascadePlacement"
1561         }
1562         elsif ($tmp == 2) {
1563                 $fvwmConfig->{'Focus'} .=
1564                         "Style * TileManualPlacement"
1565         }
1566         elsif ($tmp == 3) {
1567                 $fvwmConfig->{'Focus'} .=
1568                         "Style * MinOverlapPlacement"
1569         }
1570         elsif ($tmp == 4) {
1571                 $fvwmConfig->{'Focus'} .=
1572                         "Style * MinOverlapPercentPlacement"
1573         }
1574         elsif ($tmp == 5) {
1575                 $fvwmConfig->{'Focus'} .=
1576                         "Style * ManualPlacement"
1577         }
1578         elsif ($tmp == 6) {
1579                 $fvwmConfig->{'Focus'} .=
1580                         "Style * CascadePlacement"
1581         }
1582         else { $err->{'Focus'} .= "$impossible|" }
1583         #
1584         $index++;
1585         $tmp = substr($configFromScript,$index,1);
1586         if ($tmp == 1) { $fvwmConfig->{'Focus'} .= ", GrabFocus" }
1587         elsif ($tmp == 0) { $fvwmConfig->{'Focus'} .= ", GrabFocusOff" }
1588         else { $err->{'Focus'} .= "$impossible|" }
1589         #
1590         $index++;
1591         $tmp = substr($configFromScript,$index,1);
1592         if ($tmp == 1) { $fvwmConfig->{'Focus'} .= ", UsePPosition" }
1593         elsif ($tmp == 0) { $fvwmConfig->{'Focus'} .= ", NoPPosition" }
1594         else { $err->{'Focus'} .= "$impossible|" }
1595         $fvwmConfig->{'Focus'} .= "\n";
1596
1597         # ----------------------------------------------- Move
1598         $fvwmConfig->{'Move'} .=
1599                 "\n# ---------------------------- Move and Resize ".
1600                 "----------------------------\n\n";
1601         $index++;
1602         $tmp = substr($configFromScript,$index,1);
1603         if ($tmp == 0) { $fvwmConfig->{'Move'} .= "Style * ResizeOpaque\n" }
1604         elsif ($tmp == 1) { $fvwmConfig->{'Move'} .= "Style * ResizeOutLine\n" }
1605         else { $err->{'Move'} .= "$impossible|" }
1606         #
1607         $index++;
1608         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1609         $index += length($tmp)+1;
1610         $configFromScript = substr($configFromScript,$index);
1611         $index = 0;
1612         if ($tmp =~ /^\d+$/) { $fvwmConfig->{'Move'} .= "OpaqueMoveSize $tmp\n" }
1613         else {
1614                 $err->{'Move'} = "Percentage for opaque move size must be an integer|";
1615                 return $err;
1616         }
1617         #
1618         $tmp = substr($configFromScript,$index,1);
1619         if ($tmp == 0) { $fvwmConfig->{'Move'} .= "Emulate MWM\n" }
1620         elsif ($tmp == 1) { $fvwmConfig->{'Move'} .= "Emulate FVWM\n" }
1621         else { $err->{'Move'} .= "$impossible|" }
1622         #
1623         $index++;
1624         $tmp = substr($configFromScript,$index,1);
1625         $hide = 0;
1626         if ($tmp == 1) { $hide = 1 }
1627         elsif ($tmp == 0) {}
1628         else { $err->{'Move'} .= "$impossible|" }
1629         #
1630         $index++;
1631         $tmp = substr($configFromScript,$index,1);
1632         if ($tmp == 1) { $hide = ($hide) ? 3 : 2 }
1633         elsif ($tmp == 0) {}
1634         else { $err->{'Move'} .= "$impossible|" }
1635         if ($hide == 0) {$fvwmConfig->{'Move'} .= "HideGeometryWindow Never\n" }
1636         elsif ($hide == 1) {$fvwmConfig->{'Move'} .= "HideGeometryWindow Resize\n" }
1637         elsif ($hide == 2) {$fvwmConfig->{'Move'} .= "HideGeometryWindow Move\n" }
1638         else { $fvwmConfig->{'Move'} .= "HideGeometryWindow\n" }
1639         #
1640         $index++;
1641         $tmp = substr($configFromScript,$index,1);
1642         if ($tmp == 0) {
1643                 $fvwmConfig->{'Move'} .= "BugOpts FlickeringMoveWorkaround Off\n"
1644         }
1645         elsif ($tmp == 1) {
1646                 $fvwmConfig->{'Move'} .= "BugOpts FlickeringMoveWorkaround On\n"
1647         }
1648         else { $err->{'Move'} .= "$impossible|" }
1649         #
1650         $index++;
1651         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1652         $index += length($tmp)+1;
1653         $configFromScript = substr($configFromScript,$index);
1654         $index = 0;
1655         $tmp = 0 if $tmp eq "";
1656         if ($tmp =~ /^\d+$/) { $fvwmConfig->{'Move'} .= "SnapAttraction $tmp " }
1657         else {
1658                 $err->{'Move'} = "Distance for snap attraction must be an integer >= 0|";
1659         }
1660         #
1661         $tmp = substr($configFromScript,$index,1);
1662         if ($tmp == 1 || $tmp == 5) { $fvwmConfig->{'Move'} .= "All" }
1663         elsif ($tmp == 2 || $tmp == 6) { $fvwmConfig->{'Move'} .= "SameType" }
1664         elsif ($tmp == 3 || $tmp == 7) { $fvwmConfig->{'Move'} .= "Windows" }
1665         elsif ($tmp == 4 || $tmp == 8) { $fvwmConfig->{'Move'} .= "Icons" }
1666         else { $err->{'Move'} .= "$impossible" }
1667         if ($tmp >= 5) { $fvwmConfig->{'Move'} .= " Screen" }
1668         $fvwmConfig->{'Move'} .= "\n";
1669         #
1670         $index++;
1671         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1672         $index += length($tmp)+1;
1673         $configFromScript = substr($configFromScript,$index);
1674         $index = 0;
1675         $tmp = 0 if $tmp eq "";
1676         if ($tmp =~ /^\d+$/) { $fvwmConfig->{'Move'} .= "SnapGrid $tmp " }
1677         else {
1678                 $err->{'Move'} .= "X attraction grid coordinate must be an integer >= 0|";
1679         }
1680         #
1681         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1682         $index += length($tmp)+1;
1683         $configFromScript = substr($configFromScript,$index);
1684         $index = 0;
1685         $tmp = 0 if $tmp eq "";
1686         if ($tmp =~ /^\d+$/) { $fvwmConfig->{'Move'} .= "$tmp" }
1687         else {
1688                 $err->{'Move'} .= "Y attraction grid coordinate must be an integer >= 0|";
1689         }
1690         $fvwmConfig->{'Move'} .= "\n";
1691         #
1692         $tmp = substr($configFromScript,$index,1);
1693         if ($tmp == 0) { $fvwmConfig->{'Move'} .= "XorValue " }
1694         elsif ($tmp == 1) { $fvwmConfig->{'Move'} .= "XorPixmap " }
1695         else { $err->{'Move'} .= "$impossible|" }
1696         #
1697         $index++;
1698         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1699         $index += length($tmp)+1;
1700         $configFromScript = substr($configFromScript,$index);
1701         $index = 0;
1702         $fvwmConfig->{'Move'} .= "$tmp\n";
1703
1704         # ------------------------------------------ Paging
1705         $fvwmConfig->{'Paging'} .=
1706                 "\n# ---------------------- Paging and Mouse Parameters ".
1707                 "----------------------\n\n";
1708         $tmp = substr($configFromScript,$index,1);
1709         $index++;
1710         $tmp2 = substr($configFromScript,$index,1);
1711         $tmp2 = ($tmp2) ? 1000 : 1;
1712         $x = 0;
1713         if ($tmp == 0) { $x = 0 }
1714         elsif ($tmp == 1) { $x = 100 * $tmp2 }
1715         elsif ($tmp == 2) { $x = 90 * $tmp2 }
1716         elsif ($tmp == 3) { $x = 75 * $tmp2 }
1717         elsif ($tmp == 4) { $x = 66 * $tmp2 }
1718         elsif ($tmp == 5) { $x = 50 * $tmp2 }
1719         elsif ($tmp == 6) { $x = 33 * $tmp2 }
1720         elsif ($tmp == 7) { $x = 25 * $tmp2 }
1721         elsif ($tmp == 8) { $x = 10 * $tmp2 }
1722         elsif ($tmp == 9) { $x = 5 * $tmp2 }
1723         else { $err->{'Paging'} .= "$impossible|" }
1724         #
1725         $index++;
1726         $tmp = substr($configFromScript,$index,1);
1727         $index++;
1728         $tmp2 = substr($configFromScript,$index,1);
1729         $tmp2 = ($tmp2) ? 1000 : 1;
1730         $y = 0;
1731         if ($tmp == 0) { $y = 0 }
1732         elsif ($tmp == 1) { $y = 100 * $tmp2 }
1733         elsif ($tmp == 2) { $y = 90 * $tmp2 }
1734         elsif ($tmp == 3) { $y = 75 * $tmp2 }
1735         elsif ($tmp == 4) { $y = 66 * $tmp2 }
1736         elsif ($tmp == 5) { $y = 50 * $tmp2 }
1737         elsif ($tmp == 6) { $y = 33 * $tmp2 }
1738         elsif ($tmp == 7) { $y = 25 * $tmp2 }
1739         elsif ($tmp == 8) { $y = 10 * $tmp2 }
1740         elsif ($tmp == 9) { $y = 5 * $tmp2 }
1741         else { $err->{'Paging'} .= "$impossible|" }
1742         $fvwmConfig->{'Paging'} .= "EdgeScroll $x $y\n";
1743         #
1744         $index++;
1745         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1746         $index += length($tmp)+1;
1747         $configFromScript = substr($configFromScript,$index);
1748         $index = 0;
1749         $tmp = 0 if $tmp eq "";
1750         if ($tmp =~ /^\d+$/) { $x = "$tmp " }
1751         else { $err->{'Paging'} = "Paging delay must be an integer >= 0|" }
1752         #
1753         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1754         $index += length($tmp)+1;
1755         $configFromScript = substr($configFromScript,$index);
1756         $index = 0;
1757         $tmp = 0 if $tmp eq "";
1758         if ($tmp =~ /^\d+$/) { $y = "$tmp " }
1759         else { $err->{'Paging'} = "Moving resistance must be an integer >= 0|" }
1760         $fvwmConfig->{'Paging'} .= "EdgeResistance $x $y\n";
1761         #
1762         $tmp = substr($configFromScript,$index,1);
1763         if ($tmp == 1) { $fvwmConfig->{'Paging'} .= "EdgeThickness 1\n" }
1764         elsif ($tmp == 2) { $fvwmConfig->{'Paging'} .= "EdgeThickness 1\n" }
1765         else { $err->{'Paging'} .= "$impossible|" }
1766         #
1767         $index++;
1768         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1769         $index += length($tmp)+1;
1770         $configFromScript = substr($configFromScript,$index);
1771         $index = 0;
1772         $tmp = 150 if $tmp eq "";
1773         if ($tmp =~ /^\d+$/) { $fvwmConfig->{'Paging'} .= "ClickTime $tmp\n" }
1774         else { $err->{'Paging'} = "Double Click time must be an integer >= 0|" }
1775         #
1776         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1777         $index += length($tmp)+1;
1778         $configFromScript = substr($configFromScript,$index);
1779         $index = 0;
1780         $tmp = 3 if $tmp eq "";
1781         if ($tmp =~ /^\d+$/) { $fvwmConfig->{'Paging'} .= "MoveThreshold $tmp\n" }
1782         else { $err->{'Paging'} = "Move Threshold must be an integer >= 0|" }
1783
1784         # ----------------------------------------------- Transient
1785         $fvwmConfig->{'Transient'} .=
1786                 "\n# -------------------- Transient Windows and Animation ".
1787                 "--------------------\n\n";
1788         $tmp = substr($configFromScript,$index,1);
1789         if ($tmp == 0) {
1790                 $fvwmConfig->{'Transient'} .= "Style * DecorateTransient"
1791         }
1792         elsif ($tmp == 1) {
1793                 $fvwmConfig->{'Transient'} .= "Style * NakedTransient"
1794         }
1795         else { $err->{'Transient'} .= "$impossible|" }
1796         #
1797         $index++;
1798         $tmp = substr($configFromScript,$index,1);
1799         if ($tmp == 0) { $fvwmConfig->{'Transient'} .= ", DontRaiseTransient" }
1800         elsif ($tmp == 1) { $fvwmConfig->{'Transient'} .= ", RaiseTransient" }
1801         else { $err->{'Transient'} .= "$impossible|" }
1802         #
1803         $index++;
1804         $tmp = substr($configFromScript,$index,1);
1805         if ($tmp == 0) { $fvwmConfig->{'Transient'} .= ", DontLowerTransient" }
1806         elsif ($tmp == 1) { $fvwmConfig->{'Transient'} .= ", LowerTransient" }
1807         else { $err->{'Transient'} .= "$impossible|" }
1808         #
1809         $index++;
1810         $tmp = substr($configFromScript,$index,1);
1811         if ($tmp == 0) { $fvwmConfig->{'Transient'} .= ", DontStackTransientParent"}
1812         elsif ($tmp == 1) { $fvwmConfig->{'Transient'} .= ", StackTransientParent" }
1813         else { $err->{'Transient'} .= "$impossible|" }
1814         #
1815         $index++;
1816         $tmp = substr($configFromScript,$index,1);
1817         if ($tmp == 0) { $fvwmConfig->{'Transient'} .= ", GrabFocusTransientOff" }
1818         elsif ($tmp == 1) { $fvwmConfig->{'Transient'} .= ", GrabFocusTransient" }
1819         else { $err->{'Transient'} .= "$impossible|" }
1820         $fvwmConfig->{'Transient'} .= "\n";
1821         #
1822         $index++;
1823         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1824         $index += length($tmp)+1;
1825         $configFromScript = substr($configFromScript,$index);
1826         $index = 0;
1827         $tmp = 20 if $tmp eq "";
1828         if ($tmp =~ /^\d+$/) {
1829                 $fvwmConfig->{'Transient'} .= "Style * WindowShadeSteps $tmp"
1830         }
1831         else { $err->{'Transient'} = "Shade step must be an integer >= 0|" }
1832         #
1833         $tmp = substr($configFromScript,$index,1);
1834         if ($tmp == 1) { $fvwmConfig->{'Transient'} .= ", WindowShadeScrolls" }
1835         elsif ($tmp == 0) { $fvwmConfig->{'Transient'} .= ", WindowShadeShrinks" }
1836         else { $err->{'Transient'} .= "$impossible|" }
1837         $fvwmConfig->{'Transient'} .= "\n";
1838         #
1839         $index++;
1840         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1841         $index += length($tmp)+1;
1842         $configFromScript = substr($configFromScript,$index);
1843         $index = 0;
1844         $tmp = 10 if $tmp eq "";
1845         if ($tmp =~ /^\d+$/) { $fvwmConfig->{'Transient'} .= "SetAnimation  $tmp " }
1846         else { $err->{'Transient'} = "Animation speed must be an integer >= 0|" }
1847         #
1848         $tmp = substr($configFromScript,$index,index($configFromScript,"!")-$index);
1849         $index += length($tmp)+1;
1850         $configFromScript = substr($configFromScript,$index);
1851         $index = 0;
1852         @list = split(/\s+/,$tmp);
1853         $tmp2 = 1;
1854         foreach (@list) { $tmp2 = 0 if $_ !~ /^-?\d*\.?\d*$/ }
1855         if ($tmp2) { $fvwmConfig->{'Transient'} .= " $tmp" }
1856         else {
1857                 $err->{'Transient'} =
1858                         "Animation Steps must be a sequence of < 17 rationals around 0 to 1|"
1859         }
1860         $fvwmConfig->{'Transient'} .= "\n";
1861
1862         # ----------------------------------------------- Hints
1863         $fvwmConfig->{'Hints'} .=
1864                 "\n# -------------------- Hints, Busy Cursor and Advanced ".
1865                 "--------------------\n\n";
1866         $tmp = substr($configFromScript,$index,1);
1867         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= "Style * NoDecorHint" }
1868         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= "Style * MwmDecor" }
1869         else { $err->{'Hints'} .= "$impossible|" }
1870         #
1871         $index++;
1872         $tmp = substr($configFromScript,$index,1);
1873         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= ", NoOLDecor" }
1874         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= ", OLDecor" }
1875         else { $err->{'Hints'} .= "$impossible|" }
1876         #
1877         $index++;
1878         $tmp = substr($configFromScript,$index,1);
1879         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= ", HintOverride" }
1880         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= ", NoOverride" }
1881         else { $err->{'Hints'} .= "$impossible|" }
1882         #
1883         $index++;
1884         $tmp = substr($configFromScript,$index,1);
1885         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= ", NoFuncHint" }
1886         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= ", MwmFunctions" }
1887         else { $err->{'Hints'} .= "$impossible|" }
1888         #
1889         $index++;
1890         $tmp = substr($configFromScript,$index,1);
1891         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= ", GNOMEIgnoreHints" }
1892         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= ", GNOMEUseHints" }
1893         else { $err->{'Hints'} .= "$impossible|" }
1894         $fvwmConfig->{'Hints'} .= "\n";
1895         #
1896         $index++;
1897         $tmp = substr($configFromScript,$index,1);
1898         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= "BugOpts ModalityIsEvil off\n" }
1899         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= "BugOpts ModalityIsEvil on\n" }
1900         else { $err->{'Hints'} .= "$impossible|" }
1901         #
1902         $index++;
1903         $tmp = substr($configFromScript,$index,1);
1904         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= "BusyCursor Read off" }
1905         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= "BusyCursor Read on" }
1906         else { $err->{'Hints'} .= "$impossible|" }
1907         #
1908         $index++;
1909         # Need to be "fixed" in other places ...
1910         $tmp = substr($configFromScript,$index,1);
1911         if ($tmp == 0) {
1912                 #$fvwmConfig->{'Hints'} .= ", Recapture off"
1913         }
1914         elsif ($tmp == 1) {
1915                 #$fvwmConfig->{'Hints'} .= ", Recapture on"
1916         }
1917         else { $err->{'Hints'} .= "$impossible|" }
1918         #
1919         $index++;
1920         $tmp = substr($configFromScript,$index,1);
1921         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= ", Wait off" }
1922         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= ", Wait on" }
1923         else { $err->{'Hints'} .= "$impossible|" }
1924         #
1925         $index++;
1926         $tmp = substr($configFromScript,$index,1);
1927         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= ", ModuleSynchronous off" }
1928         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= ", ModuleSynchronous on" }
1929         else { $err->{'Hints'} .= "$impossible|" }
1930         $fvwmConfig->{'Hints'} .= "\n";
1931         #
1932         $index++;
1933         $tmp = substr($configFromScript,$index,1);
1934         if ($tmp == 1) { $fvwmConfig->{'Hints'} .= "# Automatic detection of the color limit\n" }
1935         elsif ($tmp == 2) { $fvwmConfig->{'Hints'} .= "ColorLimit 2\n" }
1936         elsif ($tmp == 3) { $fvwmConfig->{'Hints'} .= "ColorLimit 9\n" }
1937         elsif ($tmp == 4) { $fvwmConfig->{'Hints'} .= "ColorLimit 19\n" }
1938         elsif ($tmp == 5) { $fvwmConfig->{'Hints'} .= "ColorLimit 29\n" }
1939         elsif ($tmp == 6) { $fvwmConfig->{'Hints'} .= "ColorLimit 39\n" }
1940         elsif ($tmp == 7) { $fvwmConfig->{'Hints'} .= "ColorLimit 49\n" }
1941         elsif ($tmp == 8) { $fvwmConfig->{'Hints'} .= "ColorLimit 61\n" }
1942         elsif ($tmp == 9) { $fvwmConfig->{'Hints'} .= "ColorLimit 0\n" }
1943         else { $err->{'Hints'} .= "$impossible|" }
1944         #
1945         $index++;
1946         $tmp = substr($configFromScript,$index,1);
1947         if ($tmp == 0) {
1948                 $fvwmConfig->{'Hints'} .= "BugOpts MixedVisualWorkaround off\n"
1949         }
1950         elsif ($tmp == 1) {
1951                 $fvwmConfig->{'Hints'} .= "BugOpts MixedVisualWorkaround on\n"
1952         }
1953         else { $err->{'Hints'} .= "$impossible|" }
1954         #
1955         $index++;
1956         $tmp = substr($configFromScript,$index,1);
1957         if ($tmp == 0) {
1958                 $fvwmConfig->{'Hints'} .= "BugOpts RaiseOverNativeWindows off\n"
1959         }
1960         elsif ($tmp == 1) {
1961                 $fvwmConfig->{'Hints'} .= "BugOpts RaiseOverNativeWindows on\n"
1962         }
1963         else { $err->{'Hints'} .= "$impossible|" }
1964         #
1965         $index++;
1966         $tmp = substr($configFromScript,$index,1);
1967         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= "Style * SaveUnderOff" }
1968         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= "Style * SaveUnder"}
1969         else { $err->{'Hints'} .= "$impossible|" }
1970         #
1971         $index++;
1972         $tmp = substr($configFromScript,$index,1);
1973         if ($tmp == 0) { $fvwmConfig->{'Hints'} .= ", BackingStoreOff" }
1974         elsif ($tmp == 1) { $fvwmConfig->{'Hints'} .= ", BackingStore" }
1975         else { $err->{'Hints'} .= "$impossible|" }
1976         $fvwmConfig->{'Hints'} .= "\n";
1977         #
1978         $index++;
1979         $tmp = substr($configFromScript,$index,1);
1980         if ($tmp == 1) { $fvwmConfig->{'Hints'} .= "ModuleTimeout 2\n" }
1981         elsif ($tmp == 2) { $fvwmConfig->{'Hints'} .= "ModuleTimeout 5\n" }
1982         elsif ($tmp == 3) { $fvwmConfig->{'Hints'} .= "ModuleTimeout 7\n" }
1983         elsif ($tmp == 4) { $fvwmConfig->{'Hints'} .= "ModuleTimeout 10\n" }
1984         elsif ($tmp == 5) { $fvwmConfig->{'Hints'} .= "ModuleTimeout 15\n" }
1985         elsif ($tmp == 6) { $fvwmConfig->{'Hints'} .= "ModuleTimeout 30\n" }
1986         elsif ($tmp == 7) { $fvwmConfig->{'Hints'} .= "ModuleTimeout 45\n" }
1987         elsif ($tmp == 8) { $fvwmConfig->{'Hints'} .= "ModuleTimeout 60\n" }
1988         elsif ($tmp == 8) { $fvwmConfig->{'Hints'} .= "ModuleTimeout 120\n" }
1989
1990         else { $err->{'Hints'} .= "$impossible|" }
1991 }
1992
1993
1994 #-----------------------------------------------------------------------------
1995 # Parse globalfeel file and build a sequence "for" FvwmScript
1996
1997 sub parse_globalfeel_Config {
1998         my $file = shift;
1999         my $configForScript = shift;
2000         my $keys = shift;
2001
2002         my $config = {};
2003         default_globalfeel_Config($config);
2004         @$keys = ("Focus", "Move", "Paging", "Transient", "Hints");
2005
2006         open(FILE,"$file") || return "Err: cannot open $file";
2007         my $multiline = "";
2008         my $line;
2009         my $oldPlacement = 0;
2010
2011         while(<FILE>) {
2012                 chomp;
2013                 if ( /\\$/ && ! /\\\\$/) {
2014                         s/\\$//;
2015                         $multiline = $multiline . $_;
2016                         next;
2017                 } else {
2018                         $line= $multiline . $_;
2019                         $multiline = "";
2020                 }
2021                 # remove starting blanc:
2022                 $line =~ s/^\s+//;
2023                 # removing comments
2024                 next if $line =~ /^\#/;
2025                 # humm ...
2026                 $line =~ s/\s+\#.*$//;
2027                 $line =~ s/\s+$//;
2028
2029                 if ($line =~ /^ColormapFocus\s+FollowsMouse/i) {
2030                         $config->{'colormapmouse'} = 0
2031                 }
2032                 elsif ($line =~ /^ColormapFocus\s+FollowsFocus/i) {
2033                         $config->{'colormapmouse'} = 1
2034                 }
2035                 elsif ($line =~ /^OpaqueMoveSize/i) {
2036                         if ($line =~ /^OpaqueMoveSize\s+(\d+)/i) {
2037                                 $config->{'OpaqueMoveSize'} = $1
2038                         }
2039                         else {
2040                                 $config->{'OpaqueMoveSize'} = 5
2041                         }
2042                 }
2043                 elsif ($line =~ /^Emulate/i) {
2044                         if ($line =~ /^Emulate\s+mwm/i) {
2045                                 $config->{'emulate'} = 0
2046                         }
2047                         else {
2048                                 $config->{'emulate'} = 1
2049                         }
2050                 }
2051                 elsif ($line =~ /^HideGeometryWindow\s+(.*)/i) {
2052                         my @opt = split $1;
2053                         foreach (@opt) {
2054                                 s/\s//g;
2055                                 if (/^Never/i) {
2056                                         $config->{'hidemove'} = 0; $config->{'hideresize'} = 0
2057                                 }
2058                                 elsif (/^Move/) {  $config->{'hidemove'} = 1 }
2059                                 elsif (/^Resize/) {  $config->{'hideresize'} = 1 }
2060                         }
2061                 }
2062                 elsif ($line =~ /^SnapAttraction\s+([-]*\d+)\s*(\w*)\s*(.*)/i) {
2063                         my $type = "";
2064                         my $screen = 0;
2065                         $config->{'snapdistance'} = $1;
2066                         $type = $2 if defined $2;
2067                         $screen = 1 if defined $3 && $3 =~ /^screen/i;
2068                         if ($type =~ /^All$/i) {
2069                                 $config->{'snapbehavior'} = 1
2070                         }
2071                         elsif ($type =~ /^SameType$/i) {
2072                                 $config->{'snapbehavior'} = 2
2073                         }
2074                         elsif ($type =~ /^Windows$/i) {
2075                                 $config->{'snapbehavior'} = 3
2076                         }
2077                         elsif ($type =~ /^Icons$/i) {
2078                                 $config->{'snapbehavior'} = 4
2079                         }
2080                         $config->{'snapbehavior'} += 4 if ($screen eq "1");
2081                 }
2082                 elsif ($line =~ /^SnapGrid\s+(\d+)\s+(\d+)/i) {
2083                         $config->{'snap_X'} = $1;
2084                         $config->{'snap_Y'} = $2;
2085                 }
2086                 elsif ($line =~ /^BugOpts\s+(.+)$/i) {
2087                         my $token = $1;
2088                         while($token ne "") {
2089                                 my $opt = getNextToken(\$token);
2090                                 my $bool = getBoolArg(\$token);
2091                                 if ($opt =~ /^FlickeringMoveWorkaround$/i) {
2092                                         $config->{'FlickeringMoveWorkaround'} = ($bool eq "1") ? 1:0;
2093                                 }
2094                                 elsif ($opt =~ /^ModalityIsEvil$/i) {
2095                                         $config->{'ModalityIsEvil'} = ($bool eq "0") ? 0:1;
2096                                 }
2097                                 elsif ($opt =~ /^MixedVisualWorkaround$/i) {
2098                                         $config->{'MixedVisualWorkaround'} = ($bool eq "1") ? 1:0;
2099                                 }
2100                                 elsif ($opt =~ /^RaiseOverNativeWindow$/i) {
2101                                         $config->{'RaiseOverNativeWindows'} = ($bool eq "1") ? 1:0;
2102                                 }
2103                         }
2104                 }
2105                 elsif ($line =~ /^xorvalue\s+(\d+)$/i) {
2106                         $config->{'xor'}= 0;
2107                         $config->{'xor_value'}= $1;
2108                 }
2109                 elsif ($line =~ /^xorpixmap\s+(.+)$/i) {
2110                         $config->{'xor'}= 1;
2111                         $config->{'xor_pixmap'}= $1;
2112                 }
2113                 elsif ($line =~ /^BusyCursor\s+(.+)$/i) {
2114                         my $token = $1;
2115                         while($token ne "") {
2116                                 my $opt = getNextToken(\$token);
2117                                 my $bool = getBoolArg(\$token);
2118                                 next if $bool != 0 && $bool != 1;
2119                                 if ($opt =~ /^Read$/i) {
2120                                         $config->{'Busy_Read'}=$bool;
2121                                 }
2122                                 elsif ($opt =~ /^Read$/i) {
2123                                         $config->{'Busy_Recapture'}=$bool;
2124                                 }
2125                                 elsif ($opt =~ /^Recapture$/i) {
2126                                         $config->{'Busy_Recapture'}=$bool;
2127                                 }
2128                                 elsif ($opt =~ /^Wait$/i) {
2129                                         $config->{'Busy_Wait'}=$bool;
2130                                 }
2131                                 elsif ($opt =~ /^ModuleSynchronous$/i) {
2132                                         $config->{'Busy_Module'}=$bool;
2133                                 }
2134                         }
2135                 }
2136                 elsif ($line =~ /^ColorLimit\s+(\d+)/) {
2137                         $config->{'ColorLimit'} = $1
2138                 }
2139                 elsif ($line =~ /^ModuleTimeout\s+(\d+)/) {
2140                         $config->{'ModuleTimeout'} = $1
2141                 }
2142                 elsif ($line =~ /^EdgeScroll\s+(\d+)\s+(\d+)/) {
2143                         $config->{'EdgeScroll_H'} = $1;
2144                         $config->{'EdgeScroll_V'} = $2;
2145                 }
2146                 elsif ($line =~ /^EdgeThickness\s+(\d)/) {
2147                         $config->{'EdgeThickness'} = 2 if $1 == 2
2148                 }
2149                 elsif ($line =~ /EdgeResistance\s+(\d+)\s+(\d+)/) {
2150                         $config->{'EdgeResistance_delay'} = $1;
2151                         $config->{'EdgeResistance_move'} = $2;
2152                 }
2153                 elsif ($line =~ /^ClickTime\s+(\d*)\s*$/) {
2154                         $config->{'ClickTime'} = $1;
2155                 }
2156                 elsif ($line =~ /^MoveThreshold\s+(\d*)\s*$/) {
2157                         $config->{'MoveThreshold'} = $1;
2158                 }
2159                 elsif ($line =~ /^SetAnimation\s*(\d*)\s*(.*)/i) {
2160                         $config->{'SetAnimatin_speed'} = $1 if defined $1;
2161                         $config->{'SetAnimatin_frac'} = $2 if defined $2;
2162                 }
2163                 elsif ($line =~ /^Style\s+["]*[*]["]*\s+(.+)$/i) {
2164                         my $token = $1;
2165                         while($token ne "") {
2166                                 my $style = getNextStyle(\$token);
2167                                 if ($style =~ /^ClickToFocus$/i) {
2168                                         $config->{'focus'} = 1
2169                                 }
2170                                 elsif ($style=~/^MouseFocus$/i || $style=~/^FocusFollowsMouse$/i) {
2171                                         $config->{'focus'} = 2
2172                                 }
2173                                 elsif ($style =~ /^SloppyFocus$/i) {
2174                                         $config->{'focus'} = 3
2175                                 }
2176                                 elsif ($style =~ /^ClickToFocusPassesClick$/i) {
2177                                         $config->{'ClickToFocusPassesClick'} = 1
2178                                 }
2179                                 elsif ($style =~ /^ClickToFocusPassesClickOff$/i) {
2180                                         $config->{'ClickToFocusPassesClick'} = 0
2181                                 }
2182                                 elsif ($style =~ /^ClickToFocusRaises$/i) {
2183                                         $config->{'ClickToFocusRaises'} = 1
2184                                 }
2185                                 elsif ($style =~ /^ClickToFocusRaisesOff$/i) {
2186                                         $config->{'ClickToFocusRaises'} = 0
2187                                 }
2188                                 elsif ($style =~ /^MouseFocusClickRaisesOff$/i) {
2189                                         $config->{'MouseFocusClickRaisesOff'} = 1
2190                                 }
2191                                 elsif ($style =~ /^MouseFocusClickRaises$/i) {
2192                                         $config->{'MouseFocusClickRaisesOff'} = 0
2193                                 }
2194                                 ### old placement style (style supported)
2195                                 elsif ($style =~ /^SmartPlacement$/i) {
2196                                         $oldPlacement = 1;
2197                                         $config->{'SmartPlacement'} = 1
2198                                 }
2199                                 elsif ($style =~ /^DumbPlacement$/i) {
2200                                         $oldPlacement = 1;
2201                                         $config->{'SmartPlacement'} = 0
2202                                 }
2203                                 elsif ($style =~ /^CleverPlacementOff$/i) {
2204                                         $oldPlacement = 1;
2205                                         $config->{'CleverPlacementOff'} = 1
2206                                 }
2207                                 elsif ($style =~ /^CleverPlacement$/i) {
2208                                         $oldPlacement = 1;
2209                                         $config->{'CleverPlacementOff'} = 0
2210                                 }
2211                                 elsif ($style =~ /^RandomPlacement$/i) {
2212                                         $oldPlacement = 1;
2213                                         $config->{'RandomPlacement'} = 1
2214                                 }
2215                                 elsif ($style =~ /^ActivePlacement$/i) {
2216                                         $oldPlacement = 1;
2217                                         $config->{'RandomPlacement'} = 0
2218                                 }
2219                                 ### new placement style
2220                                 elsif ($style =~ /^TileCascadePlacement$/i) {
2221                                         $oldPlacement = 0;
2222                                         $config->{'placement'} = 1
2223                                 }
2224                                 elsif ($style =~ /^TileManualPlacement$/i) {
2225                                         $oldPlacement = 0;
2226                                         $config->{'placement'} = 2
2227                                 }
2228                                 elsif ($style =~ /^MinOverlapPlacement$/i) {
2229                                         $oldPlacement = 0;
2230                                         $config->{'placement'} = 3
2231                                 }
2232                                 elsif ($style =~ /^MinOverlapPercentPlacement$/i) {
2233                                         $config->{'placement'} = 4
2234                                 }
2235                                 elsif ($style =~ /^ManualPlacement$/i) {
2236                                         $oldPlacement = 0;
2237                                         $config->{'placement'} = 5
2238                                 }
2239                                 elsif ($style =~ /^CascadePlacement$/i) {
2240                                         $oldPlacement = 0;
2241                                         $config->{'placement'} = 6
2242                                 }
2243                                 # end of new placement style
2244                                 elsif ($style =~ /^GrabFocusOff$/i) {
2245                                         $config->{'GrabFocusOff'} = 0
2246                                 }
2247                                 elsif ($style =~ /^GrabFocus$/i) {
2248                                         $config->{'GrabFocusOff'} = 1
2249                                 }
2250                                 elsif ($style =~ /^NoPPosition$/i) {
2251                                         $config->{'NoPPosition'} = 0
2252                                 }
2253                                 elsif ($style =~ /^UsePPosition$/i) {
2254                                         $config->{'NoPPosition'} = 1
2255                                 }
2256                                 elsif ($style =~ /^ResizeOutLine$/i) {
2257                                         $config->{'ResizeOutLine'} = 1
2258                                 }
2259                                 elsif ($style =~ /^ResizeOpaque$/i) {
2260                                         $config->{'ResizeOutLine'} = 0
2261                                 }
2262                                 elsif ($style =~ /^SaveUnderOff$/i) {
2263                                         $config->{'SaveUnderOff'} = 0
2264                                 }
2265                                 elsif ($style =~ /^SaveUnder$/i) {
2266                                         $config->{'SaveUnderOff'} = 1
2267                                 }
2268                                 elsif ($style =~ /^BackingStoreOff$/i) {
2269                                         $config->{'BackinStoreOff'} = 0
2270                                 }
2271                                 elsif ($style =~ /^BackingStore$/i) {
2272                                         $config->{'BackingStoreOff'} = 1
2273                                 }
2274                                 elsif ($style =~ /^NakedTransient$/i) {
2275                                         $config->{'NakedTransient'} = 1
2276                                 }
2277                                 elsif ($style =~ /^DecorateTransient$/i) {
2278                                         $config->{'NakedTransient'} = 0
2279                                 }
2280                                 elsif ($style =~ /^DontRaiseTransient$/i) {
2281                                         $config->{'DontRaiseTransient'} = 0
2282                                 }
2283                                 elsif ($style =~ /^RaiseTransient$/i) {
2284                                         $config->{'DontRaiseTransient'} = 1
2285                                 }
2286                                 elsif ($style =~ /^DontLowerTransient$/i) {
2287                                         $config->{'DontLowerTransient'} = 0
2288                                 }
2289                                 elsif ($style =~ /^LowerTransient$/i) {
2290                                         $config->{'DontLowerTransient'} = 1
2291                                 }
2292                                 elsif ($style =~ /^DontStackTransientParent$/i) {
2293                                         $config->{'DontStackTransientParent'} = 0
2294                                 }
2295                                 elsif ($style =~ /^StackTransientParent$/i) {
2296                                         $config->{'DontStackTransientParent'} = 1
2297                                 }
2298                                 elsif ($style =~ /^GrabFocusTransientOff$/i) {
2299                                         $config->{'GrabFocusTransientOff'} = 0
2300                                 }
2301                                 elsif ($style =~ /^GrabFocusTransient$/i) {
2302                                         $config->{'GrabFocusTransientOff'} = 1
2303                                 }
2304                                 elsif ($style =~ /^WindowShadeSteps$/i) {
2305                                         if ($line = /\s*(\d+)/) {
2306                                                 $config->{'WindowShadeSteps'} = $1;
2307                                                 my $dummy = getNextToken(\$token);
2308                                         }
2309                                 }
2310                                 elsif ($style =~ /^WindowShadeScrolls$/i) {
2311                                         $config->{'WindowShadeScrolls'} = 1;
2312                                 }
2313                                 elsif ($style =~ /^WindowShadeShrinks$/i) {
2314                                         $config->{'WindowShadeScrolls'} = 0;
2315                                 }
2316                                 elsif ($style =~ /^NoDecorHint$/i) {
2317                                         $config->{'NoDecorHint'} = 0;
2318                                 }
2319                                 elsif ($style =~ /^MwmDecor$/i) {
2320                                         $config->{'NoDecorHint'} = 1;
2321                                 }
2322                                 elsif ($style =~ /^NoOLDecor$/i) {
2323                                         $config->{'NoOLDecor'} = 0;
2324                                 }
2325                                 elsif ($style =~ /^OLDecor$/i) {
2326                                         $config->{'NoOLDecor'} = 1;
2327                                 }
2328                                 elsif ($style =~ /^NoOverride$/i) {
2329                                         $config->{'NoOverride'} = 1;
2330                                 }
2331                                 elsif ($style =~ /^HintOverride$/i) {
2332                                         $config->{'NoOverride'} = 0;
2333                                 }
2334                                 elsif ($style =~ /^NoFuncHint$/i) {
2335                                         $config->{'NoFuncHint'} = 0;
2336                                 }
2337                                 elsif ($style =~ /^MwmFunctions$/i) {
2338                                         $config->{'NoDecorHint'} = 1;
2339                                 }
2340                                 elsif ($style =~ /^GNOMEUseHints$/i) {
2341                                         $config->{'GNOMEUseHints'} = 1;
2342                                 }
2343                                 elsif ($style =~ /^GNOMEIgnoreHints$/i) {
2344                                         $config->{'GNOMEUseHints'} = 1;
2345                                 }
2346                         }
2347                 }
2348         }
2349         close(FILE);
2350
2351         # compute clickraise
2352         if ($config->{'focus'} == 1) {
2353                 $config->{'clickraise'} = $config->{'ClickToFocusRaises'}
2354         }
2355         else {
2356                 $config->{'clickraise'} = $config->{'MouseFocusClickRaisesOff'} ? 0:1
2357         }
2358         # compute placement
2359         if ($oldPlacement) {
2360                 if ($config->{'SmartPlacement'}) {
2361                         if (!$config->{'RandomPlacement'}) {
2362                                 $config->{'placement'} = 2
2363                         }
2364                         elsif ($config->{'CleverPlacementOff'}) {
2365                                 $config->{'placement'} = 1
2366                         }
2367                         else {
2368                                 $config->{'placement'} = 3
2369                         }
2370                 }
2371                 elsif ($config->{'RandomPlacement'}) {
2372                         $config->{'placement'} = 6
2373                 }
2374                 else {
2375                         $config->{'placement'} = 5
2376                 }
2377         }
2378         # compute EdgeScroll
2379         my $scroll_h = int($config->{'EdgeScroll_H'}/1000);
2380         if ($scroll_h <= 0) { $config->{'circular_h'} = 0 }
2381         else { $config->{'EdgeScroll_H'} = $scroll_h; $config->{'circular_h'} = 1 }
2382         if ($config->{'EdgeScroll_H'} <= 0) { $config->{'edgescroll_h'} = 0 }
2383         elsif ($config->{'EdgeScroll_H'} <= 7) { $config->{'edgescroll_h'} = 9 }
2384         elsif ($config->{'EdgeScroll_H'} <= 17) { $config->{'edgescroll_h'} = 8 }
2385         elsif ($config->{'EdgeScroll_H'} <= 29) { $config->{'edgescroll_h'} = 7 }
2386         elsif ($config->{'EdgeScroll_H'} <= 41) { $config->{'edgescroll_h'} = 6 }
2387         elsif ($config->{'EdgeScroll_H'} <= 58) { $config->{'edgescroll_h'} = 5 }
2388         elsif ($config->{'EdgeScroll_H'} <= 70) { $config->{'edgescroll_h'} = 4 }
2389         elsif ($config->{'EdgeScroll_H'} <= 82) { $config->{'edgescroll_h'} = 3 }
2390         elsif ($config->{'EdgeScroll_H'} <= 95) { $config->{'edgescroll_h'} = 2 }
2391         else { $config->{'edgescroll_h'} = 1 }
2392         my $scroll_v = int($config->{'EdgeScroll_V'}/1000);
2393         if ($scroll_v <= 0) { $config->{'circular_v'} = 0 }
2394         else { $config->{'EdgeScroll_V'} = $scroll_v; $config->{'circular_v'} = 1 }
2395         if ($config->{'EdgeScroll_V'} <= 0) { $config->{'edgescroll_v'} = 0 }
2396         elsif ($config->{'EdgeScroll_V'} <= 7) { $config->{'edgescroll_v'} = 9 }
2397         elsif ($config->{'EdgeScroll_V'} <= 17) { $config->{'edgescroll_v'} = 8 }
2398         elsif ($config->{'EdgeScroll_V'} <= 29) { $config->{'edgescroll_v'} = 7 }
2399         elsif ($config->{'EdgeScroll_V'} <= 41) { $config->{'edgescroll_v'} = 6 }
2400         elsif ($config->{'EdgeScroll_V'} <= 58) { $config->{'edgescroll_v'} = 5 }
2401         elsif ($config->{'EdgeScroll_V'} <= 70) { $config->{'edgescroll_v'} = 4 }
2402         elsif ($config->{'EdgeScroll_V'} <= 82) { $config->{'edgescroll_v'} = 3 }
2403         elsif ($config->{'EdgeScroll_V'} <= 95) { $config->{'edgescroll_v'} = 2 }
2404         else { $config->{'edgescroll_v'} = 1 }
2405         # Compute Color Limit
2406         if ($config->{'ColorLimit'} < 0) { $config->{'color_limit'} = 1 }
2407         elsif ($config->{'ColorLimit'} == 0) { $config->{'color_limit'} = 9 }
2408         elsif ($config->{'ColorLimit'} <= 2) { $config->{'color_limit'} = 2 }
2409         elsif ($config->{'ColorLimit'} <= 14) { $config->{'color_limit'} = 3 }
2410         elsif ($config->{'ColorLimit'} <= 24) { $config->{'color_limit'} = 4 }
2411         elsif ($config->{'ColorLimit'} <= 34) { $config->{'color_limit'} = 5 }
2412         elsif ($config->{'ColorLimit'} <= 44) { $config->{'color_limit'} = 6 }
2413         elsif ($config->{'ColorLimit'} <= 54) { $config->{'color_limit'} = 7 }
2414         else { $config->{'color_limit'} = 8 }
2415         # Compute module timeout
2416         if ($config->{'ModuleTimeout'} <= 0) { $config->{'module_timeout'} = 6 }
2417         elsif ($config->{'ModuleTimeout'} <= 3) { $config->{'module_timeout'} = 1 }
2418         elsif ($config->{'ModuleTimeout'} <= 6) { $config->{'module_timeout'} = 2 }
2419         elsif ($config->{'ModuleTimeout'} <= 8) { $config->{'module_timeout'} = 3 }
2420         elsif ($config->{'ModuleTimeout'} <= 12) { $config->{'module_timeout'} = 4 }
2421         elsif ($config->{'ModuleTimeout'} <= 20) { $config->{'module_timeout'} = 5 }
2422         elsif ($config->{'ModuleTimeout'} <= 38) { $config->{'module_timeout'} = 6 }
2423         elsif ($config->{'ModuleTimeout'} <= 53) { $config->{'module_timeout'} = 7 }
2424         elsif ($config->{'ModuleTimeout'} <= 90) { $config->{'module_timeout'} = 8 }
2425         else { $config->{'module_timeout'} = 9 }
2426
2427         $configForScript->{'Focus'} = $config->{'focus'} .
2428                 $config->{'ClickToFocusPassesClick'} . $config->{'clickraise'} .
2429                 $config->{'colormapmouse'} . $config->{'placement'} .
2430                 $config->{'GrabFocusOff'} . $config->{'NoPPosition'};
2431
2432         $configForScript->{'Move'} = $config->{'ResizeOutLine'} .
2433                 $config->{'OpaqueMoveSize'} . "!" . $config->{'emulate'} .
2434                 $config->{'hideresize'} . $config->{'hidemove'} .
2435                 $config->{'FlickeringMoveWorkaround'} .
2436                 $config->{'snapdistance'} . "!" . $config->{'snapbehavior'} .
2437                 $config->{'snap_X'} . "!" . $config->{'snap_Y'} . "!" .
2438                 $config->{'xor'} . $config->{'xor_value'} . "!" .
2439                 $config->{'xor_pixmap'} . "!";
2440
2441         $configForScript->{'Paging'} = $config->{'edgescroll_h'} .
2442                 $config->{'circular_h'} . $config->{'edgescroll_v'} .
2443                 $config->{'circular_v'} . $config->{'EdgeResistance_delay'} ."!".
2444                 $config->{'EdgeResistance_move'}."!". $config->{'EdgeThickness'} .
2445                 $config->{'ClickTime'} ."!". $config->{'MoveThreshold'}."!";
2446
2447         $configForScript->{'Transient'} = $config->{'NakedTransient'} .
2448                 $config->{'DontRaiseTransient'} . $config->{'DontLowerTransient'} .
2449                 $config->{'DontStackTransientParent'} .
2450                 $config->{'GrabFocusTransientOff'} .
2451                 $config->{'WindowShadeSteps'}. "!" . $config->{'WindowShadeScrolls'} .
2452                 $config->{'SetAnimatin_speed'}. "!". $config->{'SetAnimatin_frac'}."!";
2453
2454         $configForScript->{'Hints'} = $config->{'NoDecorHint'} .
2455                 $config->{'NoOLDecor'} . $config->{'NoOverride'} .
2456                 $config->{'NoFuncHint'} . $config->{'GNOMEUseHints'} .
2457                 $config->{'ModalityIsEvil'} .
2458                 $config->{'Busy_Read'} . $config->{'Busy_Recapture'} .
2459                 $config->{'Busy_Wait'} . $config->{'Busy_Module'} .
2460                 $config->{'color_limit'} . $config->{'MixedVisualWorkaround'} .
2461                 $config->{'RaiseOverNativeWindow'} . $config->{'SaveUnderOff'} .
2462                 $config->{'BackingStoreOff'} . $config->{'module_timeout'};
2463         return 0
2464 }
2465
2466 # ---------------------------------------------------------------------------
2467 # "default" config (but in theory the theme/default/* is loaded
2468
2469 sub default_globalfeel_Config {
2470         my $config = shift;
2471
2472         $config->{'ClickToFocusPassesClick'} = 0;
2473         $config->{'ClickToFocusRaises'} = 1;
2474         $config->{'MouseFocusClickRaisesOff'} = 1;
2475         $config->{'focus'} = 0;
2476         $config->{'colormapmouse'} = 0;
2477         $config->{'SmartPlacement'} = 1;
2478         $config->{'RandomPlacement'} = 1;
2479         $config->{'CleverPlacementOff'} = 1;
2480         $config->{'placement'} = 0;
2481         $config->{'GrabFocusOff'} = 0;
2482         $config->{'NoPPosition'} = 0;
2483         $config->{'ResizeOutLine'} = 1;
2484         $config->{'OpaqueMoveSize'} = 5;
2485         $config->{'emulate'} = 1;
2486         $config->{'hideresize'} = 0;
2487         $config->{'hidemove'} = 0;
2488         $config->{'FlickeringMoveWorkaround'} = 0;
2489         $config->{'snapdistance'} = 0;
2490         $config->{'snapbehavior'} = 1;
2491         $config->{'snap_X'} = 1;
2492         $config->{'snap_Y'} = 1;
2493         $config->{'xor'} = 0; # 0 Value, 1 Pixmap
2494         $config->{'xor_value'} = 0; # fvwm default
2495         $config->{'xor_pixmap'} = "";
2496         $config->{'BackingStoreOff'} = 0;
2497         $config->{'EdgeScroll_H'} = 0;
2498         $config->{'EdgeScroll_V'} = 0;
2499         $config->{'edgescroll_h'} = 1;
2500         $config->{'edgescroll_v'} = 1;
2501         $config->{'circular_h'} = 0;
2502         $config->{'circilar_v'} = 0;
2503         $config->{'EdgeResistance_delay'} = 0;
2504         $config->{'EdgeResistance_move'} = 0;
2505         $config->{'EdgeThickness'} = 1;
2506         $config->{'ClickTime'} = 150;
2507         $config->{'MoveThreshold'} = 3;
2508         $config->{'NakedTransient'} = 1;
2509         $config->{'DontRaiseTransient'} = 0;
2510         $config->{'DontLowerTransient'} = 0;
2511         $config->{'DontStackTransientParent'} = 0;
2512         $config->{'GrabFocusTransientOff'} = 0;
2513         $config->{'WindowShadeSteps'} = 20;
2514         $config->{'WindowShadeScrolls'} = 1;
2515         $config->{'EdgeResistance_delay'} = 0;
2516         $config->{'EdgeResistance_move'} = 0;
2517         $config->{'SetAnimatin_speed'} = 10;
2518         $config->{'SetAnimatin_frac'} = "1 0 .01 .03 .08 .18 .3 .45 .6 .75 " .
2519                 ".85 .90 .94 .97 .99 1.0";
2520         $config->{'NoDecorHint'} = 1;
2521         $config->{'NoOLDecor'} = 1;
2522         $config->{'NoOverride'} = 0;
2523         $config->{'NoFuncHint'} = 1;
2524         $config->{'GNOMEUseHints'} = 1;
2525         $config->{'ModalityIsEvil'} = 1;
2526         $config->{'Busy_Read'} = 0;
2527         $config->{'Busy_Recapture'} = 1;
2528         $config->{'Busy_Wait'} = 0;
2529         $config->{'Busy_Module'} = 0;
2530         $config->{'ColorLimit'} = -1; # No color limit config command!
2531         $config->{'color_limit'} = 1;
2532         $config->{'MixedVisualWorkaround'} = 0;
2533         $config->{'RaiseOverNativeWindow'} = 0;
2534         $config->{'SaveUnderOff'} = 0;
2535         $config->{'BackingStoreOff'} = 0;
2536         $config->{'ModuleTimeout'} = 30;
2537         $config->{'module_timeout'} = 6;
2538
2539 }
2540
2541 # -----------------------------------------------------------------------------
2542 # parsing func
2543
2544 sub getNextToken {
2545         my ($line) = @_;
2546         my $token = "";
2547
2548         $$line =~ s/^\s*,\s*//;
2549         my $quote = " ";
2550         $quote = "\"" if ($$line =~ /^\"/);
2551         $quote = "\'" if ($$line =~ /^\'/);
2552         $quote = "\`" if ($$line =~ /^\`/);
2553         $$line =~ s/^$quote//;
2554         #print "$$line\n";
2555         if ($$line =~ /$quote/) {
2556                 $token = substr($$line,0,index($$line,$quote));
2557         } else {
2558                 $token = $$line;
2559         }
2560         $$line = substr($$line,length($token));
2561         $token =~ s/$quote$//;
2562         $token =~ s/,//g;
2563         return $token;
2564 }
2565
2566 sub getNextStyle {
2567         my ($line) = @_;
2568         my $token = "";
2569
2570         $$line =~ s/^\s*,\s*//;
2571         #print "$$line\n";
2572         if ($$line =~ /,/) {
2573                 $token = substr($$line,0,index($$line,","));
2574         } else {
2575                 $token = $$line;
2576         }
2577         $$line = substr($$line,length($token));
2578         $token =~ s/,//g;
2579         return $token;
2580 }
2581
2582 sub getBoolArg {
2583         my ($line) = @_;
2584         my $t = "";
2585         my $l = 0;
2586         $$line =~ s/^\s*//;
2587         if ($$line =~ /^(on\s*,*\s*)/i) {
2588                 $l = length($1);
2589                 $t = 1
2590         }
2591         elsif  ($$line =~ /^(off\s*,*\s*)/i) {
2592                 $l = length($1);
2593                 $t = 0
2594         }
2595         elsif  ($$line =~ /^(yes\s*,*\s*)/i) {
2596                 $l = length($1);
2597                 $t = 1
2598         }
2599         elsif  ($$line =~ /^(y\s*,*\s*)/i) {
2600                 $l = length($1);
2601                 $t = 1
2602         }
2603         elsif  ($$line =~ /^(no\s*,*\s*)/i) {
2604                 $l = length($1);
2605                 $t = 0
2606         }
2607         elsif  ($$line =~ /^(n\s*,*\s*)/i) {
2608                 $l = length($1);
2609                 $t = 0
2610         }
2611         elsif ($$line =~ /^(True\s*,*\s*)/i) {
2612                 $l = length($1);
2613                 $t = 1
2614         }
2615         elsif ($$line =~ /^(T\s*,*\s*)/i) {
2616                 $l = length($1);
2617                 $t = 1
2618         }
2619         elsif ($$line =~ /^(False\s*,*\s*)/i) {
2620                 $l = length($1);
2621                 $t = 0
2622         }
2623         elsif ($$line =~ /^(False\s*,*\s*)/i) {
2624                 $l = length($1);
2625                 $t = 0
2626         }
2627         # hummm ...
2628         elsif ($$line =~ /^(toggle[,]\s*)/i) {
2629                 $l = length($1);
2630                 $t = -1
2631         }
2632         $$line = substr($$line,$l);
2633         return $t;
2634 }
2635
2636 #----------------------------------------------------------------------------
2637 #
2638
2639 sub saveToFile {
2640         my $out = shift;
2641         my $file = shift;
2642
2643         my $dir = substr($file,0,rindex($file,"/"));
2644         # using decimal (not octal) 755 is incorrect; also I have umask 02, not 022
2645         mkdir($dir, 0777 - umask()) if (! -d $dir);
2646
2647         my $date = `date +'%d-%b-%Y %T'`;
2648         chomp($date);
2649         my $user = $ENV{'USER'} || "unknown";
2650         my $host = $ENV{'HOSTNAME'} || "unknown";
2651         my $save = "# Automatically generated by FVWM-Themes $version on $date\n" .
2652                 "# for $user\@$host\n";
2653         $out = $save . $out;
2654
2655         open(OUT, ">$file");
2656         print OUT $out;
2657         close(OUT);
2658 }
2659
2660 #----------------------------------------------------------------------------
2661 #
2662
2663 sub int2hex {
2664         my @Hex=(0 .. 9, "a" .. "f");
2665         my $i= shift;
2666         # modified for speed (olicha)
2667         my $h = $Hex[$i/16] . $Hex[$i%16];
2668         return $h;
2669 }
2670
2671
2672 #----------------------------------------------------------------------------
2673 #
2674 sub getXdpyInfo {
2675
2676         my $redMask = 0;
2677         my $greenMask = 0;
2678         my $blueMask = 0;
2679         my $defaultVisual = "";
2680         my $ok = 0;
2681
2682         open(XDPY,"xdpyinfo |");
2683         while (<XDPY>) {
2684                 if (/default visual id:\s+(.*)$/) {
2685                         $defaultVisual = $1;
2686                 }
2687                 if (/visual id:\s+$defaultVisual$/) {
2688                         $ok = 1;
2689                 }
2690                 if ($ok && /red, green, blue masks:\s+([0-9a-fA-Fx]+),\s+([0-9a-fA-Fx]+),\s+([0-9a-fA-Fx]+)$/) {
2691                         $redMask = hex($1);
2692                         $greenMask = hex($2);
2693                         $blueMask = hex($3);
2694                         $ok = 0
2695                 }
2696         }
2697         close(XDPY);
2698
2699         return ($redMask,$greenMask,$blueMask)
2700 }