Merge old CVS `ian-dotfiles' repo, as a subtree where we can pick bits

[ian-dotfiles.git] / from-cvs / files / _.configs_checkconfig

diff --git a/from-cvs/files/_.configs_checkconfig b/from-cvs/files/_.configs_checkconfig
new file mode 100755 (executable)
index 0000000..77f6473
--- /dev/null
+++ b/from-cvs/files/_.configs_checkconfig
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+# New configuration script
+
+$ENV{'PATH'}.= ':/usr/openwin/bin';
+
+$_= $ENV{'DISPLAY'};
+$_= $ENV{'HOST'}.':0' if m/^:/ || m/^unix:/; 
+s/:.*$//;
+s/\.[^0-9].*$//;
+
+$pfx= shift @ARGV;
+@ARGV && warn "arguments beyond the first ignored\n";
+
+if ($_) {
+    $c{'display'}= $_;
+    $_= `xauth -i extract /dev/null $c{'display'}:0 2>&1`;
+    $c{'xauth'}= length($_) ? 'false' : 'true';
+    $_= `xdpyinfo`;
+    $c{'keycodes'}="$1-$2" if m/range:\s+minimum (\d+), maximum (\d+)\s/;
+    if (m/default screen number:\s+(\d+)\s/) {
+        $defscreen= $1;
+        $_=$' if m/\nscreen \#$defscreen:/;
+        $_="$`\n" if m/\n\S/;
+    }
+    ($c{'pixels_x'}, $c{'pixels_y'}) = ($1,$2)
+                if m/dimensions:\s+(\d+)x(\d+) pixels/;
+    ($c{'mm_x'}, $c{'mm_y'}) = ($1,$2)
+                if m/dimensions:.*\D(\d+)x(\d+) millimeters/;
+    ($c{'dpi_x'}, $c{'dpi_y'}) = ($1,$2)
+        if m/resolution:\s+(\d+)x(\d+) dots per inch/;
+    $c{'depth'} = $1 if m/depth of root window:\s+(\d+) planes/;
+    if (m/default visual id:\s+(\w+)\s/) {
+        $defvisual= $1;
+        $_=$' if m/\n  visual:\s+visual id:\s+$defvisual\s/;
+        $_="$`\n" if m/\n  visual:/;
+    }
+    $c{'visual'} = $1 if m/class:\s+(\w+)\s/;
+    $c{'depth'} = $1 if m/depth:\s+(\d+) planes/;
+}
+
+$c{'host'}= $ENV{'HOST'};
+#$c{'arch'}= $ENV{'ARCH'};
+$_= `uname -sr`; s/\s(\d+)\.\S*/$1/;
+$c{'arch'}= $_;
+
+chdir($ENV{'HOME'});
+chdir('.configs');
+
+open(L, "list") || die "$0: list: $!\n";
+
+while(<L>) {
+    s/\s*$//;
+    next if m/^#/ || m/^$/;
+    $ol= $l= $_;
+    $true=0;
+    while ($l =~ s/\s*(\S+)// && $1 ne ':') {
+        next if $true;
+        $_= $1;
+        if (m/^default$/) {
+            $true= 1;
+        } elsif (m/[<>]=?/) {
+            $lhs= $`;
+            $rhs= $';
+            $op= $&;
+            next unless defined($c{$lhs});
+            $true= eval '$c{$lhs} '.$op.' $rhs';
+        } elsif (m/=/) {
+            $lhs= $`;
+            $rhs= $';
+            next unless defined($c{$lhs});
+            $true= $c{$lhs} eq $rhs;
+        } else {
+            warn "condition `$_' in line $. not understood\n";
+        }
+    }
+    next unless $true;
+    while ($l =~ s/\s*(\S+)//) {
+        unless ($1 =~ m/=/) {
+            warn "consequence `$1' in line $. not understood\n";
+            next;
+        }
+        $c{$`}= $';
+    }
+}
+
+close(L);
+
+while (($k,$v) = each %c) {
+    print " $pfx$k=$v";
+}
+print "\n";