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