Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

WSpanel

by strredwolf (Chaplain)
on May 06, 2003 at 21:55 UTC ( #256061=sourcecode: print w/ replies, xml ) Need Help??

Category: GUI Programming
Author/Contact Info strredwolf
Description: Cheezy all-Perl/TK panel, with swallow support and a monitor applet built in. Documentation of the .wspanel.rc item there. Needs alot of cleanup, alas, but I got tired of the Gnome/KDE panels getting in the way.
#!/usr/bin/perl

### WS Panel
use Tk;
use X11::Protocol;
my $X = X11::Protocol->new();

use Tk::ProgressBar;

my $cpu_var, $mem_var, $swap_var;
my @last;

## Subroutines

sub runbtn {
    my ($id,@j)=@_;
    
    unless(fork) {
    exec $cmd{$id};
    }
}

sub gulp {
    my ($frame, $title, $cmd, @j)=@_;
    my $pid;

    unless($pid=fork) {
    exec $cmd;
    }
    if($pid) {
    grab_it($title,$frame);
    }
}

sub grab_it {
    my $winname = shift;
    my $pane = shift;
    my $wid;
    my $check = $pane->repeat(50, sub {
        $wid = get_window_by_name($winname);
    });
     
    while (!defined $wid) {
        $pane->waitVariable(\$wid);
    }
    $check->cancel;
    
    my $f = $pane->Frame('-container' => 1)->pack(-side => 'bottom');
    $f->update;
    $X->ReparentWindow($wid, oct($f->id), 0, 0);
}
 
sub get_window_by_name {
    _get_window_by_name($X->{'root'}, $_[0]);
}
 
sub _get_window_by_name {
    my($root, $searchname) = @_;
    my(undef, undef, @new_kids) = $X->QueryTree($root);
    foreach my $k (@new_kids) {
        my $atomnr;
        foreach my $atom ($X->ListProperties($k)) {
            if ($X->GetAtomName($atom) eq "WM_CLASS") {
        $atomnr = $atom;
                last;
            }
        }
    if (defined $atomnr) {
        my($classprop) = $X->GetProperty($k, $atomnr, "AnyPropertyType
+",0, 256, 0);
        my($class, $name) = split(/\0/, $classprop);
        if ($class eq $searchname) {
        return $k;
        }
    }
    my $ret = _get_window_by_name($k, $searchname);
    if (defined $ret) {
        return $ret;
    }
    }
    undef;
}

sub update_monitor {
    my $ref=shift;
    open(IN,"</proc/meminfo") || die;
    my $l=<IN>;
    my $a,$b;
    $l=<IN>; chomp $l;
    $l=~/^Mem:\s+(\d+)\s+(\d+)/;  $mem_var=$2/$1*100;
    $l=<IN>; chomp $l;
    $l=~/^Swap:\s+(\d+)\s+(\d+)/;  $swap_var=$2/$1*100;
    open(IN,"</proc/stat") || die;
    $l=<IN>; chomp $l; 
    $l=~/^cpu\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/; $a=$1+$2+$3;
    
    $cpu_var=($a-$last[0])*100/($a+$4-$last[1]);
    @last=($a,$a+$4);
    close(IN);
    ${$ref}->update;
}

sub special {
    my ($frame,$plugin,$opts,@j)=@_;
    my %e;
    my $len=96;

    if($plugin=~/^monitor/i) {
    $e{'cpu'}=$frame->ProgressBar(-background=>'black',
                      -colors=>[0,'green'],
                      -width=>18,-blocks=>64,-length=>$len,
                      -gap=>0, -variable=>\$cpu_var,
                      -anchor=>'n')->pack(-side=>'left');
    $e{'s1'}=$frame->Frame(-border=>1)->pack(-side=>'left');
    $e{'mem'}=$frame->ProgressBar(-background=>'black',
                      -colors=>[0,'green'],
                      -width=>18,-blocks=>64,-length=>$len,
                      -gap=>0, -variable=>\$mem_var,
                      -anchor=>'n')->pack(-side=>'left');
    $e{'s2'}=$frame->Frame(-border=>1)->pack(-side=>'left');
    $e{'swap'}=$frame->ProgressBar(-background=>'black',
                      -colors=>[0,'green'],
                      -width=>18,-blocks=>64,-length=>$len,
                      -gap=>0, -variable=>\$swap_var,
                      -anchor=>'n')->pack(-side=>'left');
    $e{'check'}=$frame->repeat(500,[\&update_monitor,\$frame]);
    }
    return \%e;
}
 
## main()

my $w=MainWindow->new(-width=>64,-borderwidth=>2,-relief=>'raised');
$w->geometry("-0+0");
$w->resizable(0,0);
$w->overrideredirect(1);


my $i=0;
my %d, %cmd, %img, %extra;

open(IN,"</home/tygris/.wspanel.rc") || die "Can't open .wspanel.rc! $
+!";
while(<IN>) {
    chomp;
    next if/^$/;
    next if/^#/;
    
    unless(/^(\S+)\s+\[(.*)\]\s+\{(.*)\}/) {
    print "Error in .wspanel.rc, skipping line:\n\t$_\n";
    next;
    }
    
    my ($a,$b,$c)=($1,$2,$3);
    if($a=~/^pos/i) {
    $w->geometry($b);
        next;
    }
    if($a=~/^but/i) {
    $img{$i}=$w->Photo(-file=>$b);
    $d{$i}=$w->Button(-image=>$img{$i}, -border=>0, -width=>56, 
              -height=>56, -command=>[\&runbtn, $i])->pack;
    $cmd{$i}=$c;
    $i++;
    next;
    }
    if($a=~/^gulp/i) {
    $d{$i}=$w->Frame(-width=>56,-height=>56)->pack(-fill=>'x');
    &gulp($d{$i},$b,$c);
    $i++;
    next;
    }
    if($a=~/^spec/i) {
    $d{$i}=$w->Frame(-width=>56)->pack;
    $extra{$i}= &special($d{$i},$b,$c);
    $i++;
    next;
    }
}
MainLoop;

__END__

# WSPanel.rc
# Example, of course.

# Format is:
# Command [first] {second}
# Some examples...

# Where to truly put it.  Second item ignored
Position [-0+0] {}

# Swallow an application.  First for the title/class and second for th
+e command
Gulp [rclock] {rclock -geometry 56x56}

# Special stuff.  Right now, only a CPU/Mem/Swap monitor is put in.
Special [monitor] {

# Normal click button.  First for icon, Second for command to forkexec
+.}
Button [/usr/X11/include/X11/pixmaps/Monitor.xpm] {rxvt}

Comment on WSpanel
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://256061]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (4)
As of 2014-07-31 05:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (245 votes), past polls