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 22use strict; 23use Getopt::Long; 24 25my $version = '@VERSION@'; 26my $fvwmVersion = '@FVWM_VERSION@'; 27 28my $prefix = $ENV{'prefix'} || '@prefix@'; 29my $ROOT_PREFIX = $ENV{'ROOT_PREFIX'} || '@ROOT_PREFIX@'; 30$ROOT_PREFIX = $ENV{'DESTDIR'} if $ENV{'DESTDIR'}; 31my $datadir = "@datadir@"; 32 33my $userHome = $ENV{'HOME'} || "./."; 34my $userDir = $ENV{'FVWM_USERDIR'} || "$userHome/.fvwm"; 35my $currentThemeName = 'current'; 36my $themesSubDir = 'themes'; 37my $currentThemeSubDir = "$themesSubDir/$currentThemeName"; 38my $personalDirName = 'personal'; 39my $localeDir = "@FT_DATADIR@/locale"; 40 41my $scriptName = ($0 =~ m:([^/]+)$:, $1); 42my $path = ""; 43my $command_ls = 0; 44my $lsOptions = ""; 45my $type = ""; 46my $item = -1; 47my $checkExec = ""; 48# globalfeel com loop 49my $globalFeel = 0; 50my $comName = "script"; 51my $comPid = 0; 52# in line doc and script msg 53my $inLineDoc = ""; 54my $lineLength = 70; 55my $getMsg = ""; 56my $lang = ""; 57# font selector 58my $fontOpt = 0; 59my $fontFilter = ""; 60my $fontReset = 0; 61my $fontIndex = 0; 62my $fontCurrent = ""; 63my $fontStart = 0; 64my $fontOnlyAdjustable = 0; 65my $fontInfo = 0; 66 67GetOptions( 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 92if ($globalFeel) { 93 $comPid = $comName; 94 $comPid =~ s/script-//; 95 $comPid = 0 if ($comPid !~ /^\d+$/); 96 globalFeelComLoop() 97 # we never return here 98} 99elsif ($command_ls) { 100 print 101 getDirListing($path, $lsOptions, $item, $type eq "dir", $type eq "file"); 102} 103elsif ($checkExec ne "") { 104 my $r = checkExecInPath($checkExec); 105 print "$r\n"; 106} 107elsif ($inLineDoc ne "") { 108 buildDoc(); 109} 110elsif ($getMsg ne "") { 111 buildMsg(); 112} 113elsif ($fontOpt) { 114 buildFontLists(); 115} 116elsif ($fontInfo) { 117 buildFontInfo(); 118} 119# ---------------------------------------------------------------------------- 120 121sub 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 133sub 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 455sub 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 577sub 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 611sub 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 639sub 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 697sub 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 819sub 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 858sub 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 973sub 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 1006sub 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 1022sub 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): 1349sub 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# 1364sub 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! 1371END { 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 1397sub 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 1475sub 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 1503sub 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 1997sub 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 2469sub 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 2544sub 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 2566sub 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 2582sub 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 2639sub 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 2663sub 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# 2674sub 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} 2701