#!/usr/NeWS/bin/psh
	%
	% This file is a product of Sun Microsystems, Inc. and is provided for
	% unrestricted use provided that this legend is included on all tape
	% media and as a part of the software program in whole or part.
	% Users may copy, modify or distribute this file at will.
	%
	% THIS FILE IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE
	% WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR
	% PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE.
	%
	% This file is provided with no support and without any obligation on the
	% part of Sun Microsystems, Inc. to assist in its use, correction,
	% modification or enhancement.
	%
	% SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE
	% INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS FILE
	% OR ANY PART THEREOF.
	%
	% In no event will Sun Microsystems, Inc. be liable for any lost revenue
	% or profits or other special, indirect and consequential damages, even
	% if Sun has been advised of the possibility of such damages.
	%
	% Sun Microsystems, Inc.
	% 2550 Garcia Avenue
	% Mountain View, California  94043
	%
    % Copyright (c) 1988 by Sun Microsystems, Inc.

% winzap
%
% Use this tool to remove unsightly dead canvases from your NeWS server.
% The left button moves you to the next canvas and the menu button allows
% you to navigate the canvas tree.  When you see a canvas you want to zap,
% use the zap menu option.  This program should be modified to allow you
% to walk the canvas tree via pullright menus.
%
% Bruce V. Schwartz
% Sun Microsystems
% November 1988
% bschwartz@sun.com

/CurrentCanvas framebuffer /TopChild get def

% /WalkCanvas framebuffer newcanvas def
% 0 0 200 200 rectpath WalkCanvas reshapecanvas
% WalkCanvas /Retained true put
% WalkCanvas setcanvas
% .8 .8 1 rgbcolor fillcanvas
% WalkCanvas /Mapped true put
/WalkCanvas null def

/FlashCurrent % - -> -
{
	(Current canvas: %\n) [ CurrentCanvas ] dbgprintf
	{
		gsave
		CurrentCanvas setcanvas
		CurrentCanvas /Mapped get { 0 fillcanvas } if
		grestore
	} fork waitprocess pop
} def

/WalkUp % - -> -
{
	CurrentCanvas /Parent get
	dup null eq { pop framebuffer } if
	/CurrentCanvas exch def
	CurrentCanvas  canvastotop
} def

/WalkDown % - -> -
{
	CurrentCanvas /TopChild get
	dup null eq { pop CurrentCanvas } if
	/CurrentCanvas exch def
	CurrentCanvas  canvastotop
} def

/WalkLeft % - -> -
{
	CurrentCanvas canvastobottom
	/CurrentCanvas CurrentCanvas /TopCanvas get def
} def

/WalkRight % - -> -
{
	CurrentCanvas /BottomCanvas get canvastotop
	/CurrentCanvas CurrentCanvas /TopCanvas get def
} def

/ZapCurrent % - -> -
{
	CurrentCanvas /Mapped false put
	CurrentCanvas /Retained false put
	WalkLeft FlashCurrent
} def

/Exit % - -> -
{
	PaintRoot {/paint self send} AllWin
	Process killprocessgroup
} def

/WalkMenu
[
	(Up)	{ WalkUp FlashCurrent}
	(Down)	{ WalkDown FlashCurrent}
	(Left)	{ WalkLeft FlashCurrent}
	(Right)	{ WalkRight FlashCurrent}
	(Zap)	{ FlashCurrent ZapCurrent }
	(Exit)	{ Exit }
] /new DefaultMenu send def

/dealWithMenu % - -> -
{
	/showat WalkMenu send
} def


[
	LeftMouseButton
	{WalkLeft FlashCurrent}
	DownTransition WalkCanvas eventmgrinterest

	MenuButton
	{ dealWithMenu }
	DownTransition WalkCanvas eventmgrinterest
]
forkeventmgr
/Process exch def