view release on metacpan or  search on metacpan

bin/org-daemon  view on Meta::CPAN

    } else {
	warn "Can't open $file: $!";
    }
    $open_warning{$file}++;
}

sub set_x11_properties {
    my $t = shift;
    if ($Tk::platform eq 'unix') {
	my($wrapper) = $t->wrapper;
	if (!eval {
	    require Sys::Hostname;
	    $t->property("set", "_NET_WM_PID", "CARDINAL", 32, [$$], $wrapper);
	    $t->property("set", "WM_CLIENT_MACHINE", "STRING", 8, [Sys::Hostname::hostname()], $wrapper);
	    1;
	}) {
	    warn "WARNING: Setting _NET_WM_PID and WM_CLIENT_MACHINE properies failed: $@";
	}
    }
}

sub stay_on_top {
    my $t = shift;
    no warnings 'once';
    if ($Tk::platform eq 'unix') {
	my($wrapper) = $t->wrapper;
	# set sticky flag for gnome and fvwm2
	eval q{
	$t->property('set','_WIN_STATE','CARDINAL',32,[1],$wrapper); # sticky
	$t->property('set','_WIN_LAYER','CARDINAL',32,[6],$wrapper); # ontop
	};
	warn $@ if $@;
    }
    
    eval { $t->attributes(-topmost => 1) };
    warn $@ if $@;
}

# Code taken from bbbike
sub start_ptksh {
    # Is there already a (withdrawn) ptksh?
    foreach my $mw0 (Tk::MainWindow::Existing()) {
	if ($mw0->title =~ /^ptksh/) {
	    $mw0->deiconify;
	    $mw0->raise;
	    return;
	}
    }

    require Config;
    require File::Basename;
    my @perldirs = grep { defined $_ && -x $_ } ($Config::Config{'sitebin'}, $Config::Config{'scriptdir'});
    push @perldirs, File::Basename::dirname(File::Basename::dirname($^X)); # for the SiePerl installation
    my $perldir;
 TRY: {
	no warnings 'once';
	# "local" probably does not work here, we're in a MainLoop...
	$Data::Dumper::Deparse = 1; # if I need a "ptksh" window, then I need more diagnostics!
	$Data::Dumper::Sortkeys = 1;

	local @ARGV; # ptksh would read 1st argument as perl script

        # Find the ptksh script
        for $perldir (@perldirs) {
            if (-r "$perldir/ptksh") {
		require "$perldir/ptksh";
                last TRY;
            }
        }
	$perldir = File::Basename::dirname($^X);
	if (-r "$perldir/ptksh") {
	    require "$perldir/ptksh";
	} else {
	    my $f = ((Tk::MainWindow::Existing())[0])->getOpenFile
		((-d $perldir ? (-initialdir => $perldir) : ()),
		 -title => "Path to ptksh",
		);
	    if (defined $f) {
		require $f;
	    } else {
		return;
	    }
	}
    } 

    # The created mainwindow is unnecessary - destroy it
    for my $mw0 (Tk::MainWindow::Existing()) {
	if ($mw0->title eq '$mw') {
	    $mw0->destroy;
	} elsif ($mw0->title eq 'ptksh') {
	    $mw0->protocol('WM_DELETE_WINDOW' => [$mw0, 'withdraw']);
	}
    }
}

return 1 if caller;

GetOptions(
	   "d|debug!" => \$debug,
	   "recheck-interval=i" => \$recheck_interval,
	   "early-warning=i" => \$default_early_warning,
	   "early-warning-timeless=i" => \$default_timeless_early_warning,
	   "include-timeless!" => \$include_timeless,
	   'time-fallback=s' => \$time_fallback,
	   "small-font=s" => \$small_font,
	   'emacsclient-eval!' => \$use_emacsclient_eval,
	   'emacsclient-cmd=s' => \$emacsclient_fmt_cmd,
	   'overview-widget=s' => \$overview_widget,
	   'ignore-tag=s@' => \@ignore_tags,
	   'v|version' => \$show_version,
	   'move-button!' => \$with_move_button,
	   'use-anyevent' => \$use_anyevent,
	  )
    or die <<EOF;
$0 [--debug] [--early-warning=seconds] [--early-warning-timeless=seconds] [--recheck-interval=seconds]
\t[--no-emacsclient-eval] [--emacsclient-cmd=...]
\t[--overview-widget=...] [--move-button]
\t[--[no-]include-timeless] [--time-fallback HH:MM]
\t[--ignore-tag=... ...]
\torgfile ...
$0 --version