# -*- perl -*-

#
# $Id: WinCompat.pm,v 1.5 2005/03/28 23:02:25 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 1998 Slaven Rezic. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: eserte@cs.tu-berlin.de
# WWW:  http://user.cs.tu-berlin.de/~eserte/
#

package main;

#XXX del:
# eval {
#     $win32s = (!Win32::IsWinNT() and !Win32::IsWin95());
# };
# if ($win32s) {
#     # STDERR landet ansonsten im Nirvana
#     if (defined $ENV{TEMP} and -d $ENV{TEMP}) {
# 	open(W, ">$ENV{TEMP}/error.txt"); # truncate
# 	close W;
# 	my $warn_sub = sub {
# 	    open(W, ">>$ENV{TEMP}/error.txt");
# 	    print W join("\n", @_);
# 	    close W;
# 	};
# 	$SIG{__WARN__} = $SIG{__DIE__} = $warn_sub;
#     }
#     $do_www    = 0; # Internet-Zugriffe unterdrücken
#     $want_wind = 0;
#     $sfn       = 1;
# }      

if ($Tk::VERSION < 800) {
    eval q{
        package Tk::Balloon;

        sub SetStatus {
            my $w = shift;
            my $client = $w->{"client"};
            return if ((not defined $client) ||
        	       (not exists $w->{"clients"}->{$client}));
            my $msg = $w->{"clients"}->{$client}->{-statusmsg} || '';
            main::status_message($msg);
        }

        sub ClearStatus {
            main::status_message("");
        }
    };
}

package Tk::ContextHelp;
@ISA = qw(Tk::Toplevel);
Construct Tk::Widget 'ContextHelp';

sub Populate {
    my($w, $args) = @_;
    my(@keys) = keys %$args;
    foreach (@keys) {
	delete $args->{$_};
    }
    $w->withdraw;
}

sub attach { }

sub HelpButton {
    my($self, $top, %args) = @_;
    my $b = $top->Button(-text => '?',
			 -padx => 0,
			 -pady => 0,
			 -state => 'disabled');
    $b;
}

1;
