sjs@spectral.ctt.bellcore.com (Stan Switzer) (04/22/89)
This is an attempt at a recursive window manager.
In the beginning it was a pretty fun hack, but little nit-picky things
kept on complicating things to the point that I basically gave up on
it for a few months. Most of the horrible bugs are out of it, but it
must be regarded as a demonstration program only until I can ket rid
of some of the voodo in here.
In particular, I have had a VERY difficult time chasing out GC leaks
that ultimately result in window carcasses om the screen. All KNOWN
causes of this regretable circumstance have been aliminated, but
considering the truly disgusting things that this program does, there
may be no hope for a total solution.
That said, it's a pretty neat program. You might be able to get some
use out of it.
I like to make several big WinWins and group related work in the same
WinWin. I can then close up one of the winwins and open up another to
simulate multiple desktops.
Enjoy,
Stan Switzer sjs@ctt.bellcore.com
------------------------------------------------
#!/usr/NeWS/bin/psh
%
% WinWin: Windows in windows in windows ...
%
% Copyright (C) 1989 by Stan Switzer. All rights reserved.
% This program is provided for unrestricted use, provided that this
% copyright message is preserved. There is no warranty, and no author
% or distributer accepts responsibility for any damage caused by this
% program.
%
% Recursive window managment
%
% Stan Switzer sjs@ctt.bellcore.com
%
% To be fixed:
% Highly succeptable to GC leaks resulting in canvases not being
% released. The event manager's bad habit of keeping a copy of
% events around is a likely source of trouble. I have fixed this
% once and for all by patching the event manager but it still doesn't
% eliminate the leaks!
%
% Frailties:
% Shared menus retain canvases whose parent could be anything.
% The "fix" is to reparent the canvases.
%
% Interests with null canvases are problematic.
%
% Special behavior of "newcanvas" for framebuffer children is
% annoying, and can't really be fixed completely by redefinition
% owing to autobind.
%
% Shared menus make life interesting since their canvas's parent links
% have to be changed on /popup.
%
% I really don't know why it doesn't work when you have a root piemenu.
% Current "solution" is to change the rootmenu back to regular menu for
% the "winwin."
%
% NeWS Bugs:
% When a window is reshaped, where subwindows are and where they think
% they are are two different things entirely.
%
% Only true root overlay canvases cover their siblings!
%
/WinWin DefaultWindow [ ] classbegin
/IconImage /client def
/PaintIcon {
/PaintIcon super send
IconBorderColor strokecanvas
} def
/FrameLabel (Window Window) def
/ClientMenu null def
/CreateClientCanvas {
/ClientCanvas FrameCanvas newcanvas def
/ptr /ptr_m ClientCanvas setstandardcursor
ClientCanvas begin
/Transparent false def
/Retained false def
/EventsConsumed /AllEvents def
/Mapped true def
end
} def
/PaintFrameBorder { % - => - (Paint frame border areas)
clippath pathbbox rectpath
BorderLeft .5 sub BorderBottom .5 sub
FrameWidth BorderLeft BorderRight add sub 1 add
FrameHeight BorderBottom BorderTop add sub 1 add
FramePath gsave FrameFillColor setshade eofill grestore
FrameBorderColor setshade stroke FrameBorderColor strokecanvas
} def
/ForkFrameEventMgr {
/FrameEventMgr FrameInterests forkeventmgr def
} def
/destroy {
createevent dup begin
/Name /DoItEvent def
/Action /Window def
/ClientData [
% /EventMgrDict cvx /CurrentEvent null /put cvx % GC leak
ClientCanvas /framebuffer cvx /eq cvx { destroy } /if cvx
] cvx def
end sendevent
% save some memory in case of GC leaks:
ClientCanvas /Retained false put
FrameCanvas /Retained false put
% Kill some processes:
/KillProcesses where {
/KillProcesses get { killprocess } forall
/KillProcesses null store
} if
% Kill some groups:
/KillGroups where {
/KillGroups get { killprocessgroup } forall
/KillGroups null store
} if
% console (OK!\n) writestring console flushfile
/destroy super send
} def
% we only drag the frame since draging the canvas doesn't work too
% well when there are opaque children
/slide { % - => - (Interactively move window)
{
Iconic? { /slide super send } {
GetCanvas setcanvas
InteractionLock { true dragcanvas } monitor
currentcanvas ParentCanvas setcanvas getcanvaslocation
/move self send
} ifelse
} fork pop
} def
classend systemdict 3 1 roll put
currentdict framebuffer { begin } pop end % pop user dict
50 dict begin % The things we do for recursive WinWins!
/framebuffer exch def
/fboverlay framebuffer createoverlay def
/newcanvas {
dup framebuffer eq exch
systemdict /newcanvas get exec
exch {
dup /Transparent false put
dup /Color get not { dup /Retained true put } if
} if
} def
/win framebuffer /new WinWin send def
/reshapefromuser win send
/map win send
win
/win null def
end
exch begin { end } pop /win exch def
% systemdict /foo win put % pseudo-scientific visualizer
systemdict /NextSocket known not { systemdict /NextSocket 2011 put } if
/ServerSocket systemdict begin
NextSocket /NextSocket NextSocket 1 add def
end def
/FakeServer (NEWSSERVER) getenv
(;) search pop exch pop (.) search pop exch pop exch % sys addr port
pop ServerSocket 20 string cvs
(.) exch append append exch (;) exch append append def
/rebindit { % proc key val => proc
2 index % proc key val proc
&rebindit pop pop
} def
/&rebindit { % key val proc => key val
dup length 0 1 3 2 roll 1 sub { % key val proc 0 1 lng-1 { ... } for
2 copy get % key val proc ix proc[ix]
dup type /arraytype eq { % another proc?
exch pop exch 4 1 roll % proc key val proc[ix]
&rebindit 3 -1 roll % key val proc
} { % key val
dup xcheck { % executable
4 index eq { % ... and same as key?
% key val proc ix
1 index exch 3 index put % key val proc
} {
pop
} ifelse
} {
pop pop
} ifelse
} ifelse
} for
pop
} def
/Hacks dictbegin
/framebuffer win /ClientCanvas get def
/fboverlay framebuffer createoverlay def
% /fboverlay { framebuffer createoverlay dup canvastotop } def
/newcanvas {
dup framebuffer eq exch
systemdict /newcanvas get exec
exch {
dup /Transparent false put
dup /Color get not { dup /Retained true put } if
} if
} def
% note: we have to patch LiteWindow because newcanvas was autobound
% and consequently the above definition has no effect.
LiteWindow /CreateFrameCanvas get
systemdict /newcanvas get /newcanvas cvx rebindit pop
LiteWindow /CreateIconCanvas get
systemdict /newcanvas get /newcanvas cvx rebindit pop
% Likewise, LiteWindow ParentCanvas is defined as framebuffer in advance.
% We'll fix this by defining it to be { framebuffer }.
LiteMenu /ParentCanvas { framebuffer } put
[
DefaultMenu
/PieMenu where { pop PieMenu dup DefaultMenu eq { pop } if } if
] { % forall
{ % loop
dup null eq { pop exit } if
dup /showat known {
dup /showat get systemdict /newcanvas get /newcanvas cvx
rebindit % classdict showatproc
0 get /CheckParent ne {
dup /showat 2 copy get
{ CheckParent } {} modifyproc put
} if
dup /CheckParent {
MenuCanvas null ne {
MenuCanvas /Parent ParentCanvas put
} if
} put
} if
/ParentDict get
} loop
} forall
% This is gross, gross, gross, but we must improve the hygiene of
% the event manager:
/forkeventmgr load 2 get 19 get dup 22 get /repeat load eq {
dup 21 { { pop } repeat EventMgrDict /CurrentEvent null put } put
22 /exec cvx put
} {
pop
} ifelse
/AllWin { % proc => - (Distributes proc to all windows!!)
createevent dup begin
/Name /DoItEvent def
/Action /Window def
/ClientData [
% /EventMgrDict cvx /CurrentEvent null /put cvx % GC leak
framebuffer /framebuffer cvx /eq cvx [
7 index cvx /exec cvx
] cvx /if cvx
] cvx def
end sendevent pop
} def
/^C { % kill the Window of Windows
createevent dup begin
/Name /DoItEvent def
/Action /Window def
/ClientData [
% /EventMgrDict cvx /CurrentEvent null /put cvx % GC leak
framebuffer
{
ClassName /WinWin eq {
ClientCanvas eq { self /destroy exch send } if
} {
pop
} ifelse
} /exec cvx
] cvx def
end sendevent pop
} def
/exitcleanly load systemdict /^C get /^C cvx rebindit pop
/forkunix {
(NEWSSERVER) getenv
(NEWSSERVER) //FakeServer putenv
exch systemdict /forkunix get exec
(NEWSSERVER) exch putenv
} def
dictend def
Hacks /def load forall
framebuffer setcanvas PaintRoot
/DefaultMenu LitePullRightMenu def /rootmenu /flipstyle rootmenu send def
/serverproc { % fork
clear (%socketl) //ServerSocket 20 string cvs append (r) file
{ % loop
dup mark exch acceptconnection
{ % fork
Hacks end 200 dict begin { def } forall
initmatrix newprocessgroup
exch pop exch pop dup
getsocketpeername /OriginatingHost exch def
RemoteHostRegistry OriginatingHost known
OriginatingHost localhostname anchorsearch
{ pop (.) anchorsearch
{ pop pop RemoteHostRegistry localhostname known }
{ pop false } ifelse }
{ pop false } ifelse or
% Let through if no security wanted
NetSecurityWanted not or
{ cvx exec }
{ currentcursorlocation
[ (Network security violation:)
(Rejected connection from ) OriginatingHost append ]
popmsg } ifelse
currentprocess killprocessgroup
} fork
cleartomark
} loop
} fork def
/rooteventmgr [
/rootmenu where { pop
MenuButton
{ {/showat rootmenu send} fork pop }
DownTransition framebuffer eventmgrinterest
} if
/Damaged { damagepath clipcanvas PaintRoot newpath clipcanvas}
null framebuffer eventmgrinterest
] forkeventmgr def
win /KillProcesses [ serverproc rooteventmgr ] put
% win /KillGroups [ rooteventmgr ] putsjs@spectral.ctt.bellcore.com (Stan Switzer) (04/25/89)
The hackman always posts twice.... Apologies for any inconvenience.
The previous version of "winwin" didn't work. Without going into too
much detail let's just say that it worked here when I posted it, but
it had no chance to work anywhere else (unless you had autobind off
when you define your root menu). I really have to watch those
last-minute changes.
Anyway, this version is fixed (really). It remains fragile in all
ways detailed in the previous message, but it can be useful nonetheless.
As I said before, it is quite useful to set up several large winwin
windows, each containing related subwindows. In a way it's like
having multiple desktops.
As always, enjoy,
Stan Switzer sjs@ctt.bellcore.com "Thou shalt not have no idea."
--------------
#!/usr/NeWS/bin/psh
%
% WinWin: Windows in windows in windows ...
%
% Copyright (C) 1989 by Stan Switzer. All rights reserved.
% This program is provided for unrestricted use, provided that this
% copyright message is preserved. There is no warranty, and no author
% or distributer accepts responsibility for any damage caused by this
% program.
%
% Recursive window managment
%
% Stan Switzer sjs@ctt.bellcore.com
%
% To be fixed:
% Highly succeptable to GC leaks resulting in canvases not being
% released. The event manager's bad habit of keeping a copy of
% events around is a likely source of trouble. I have fixed this
% once and for all by patching the event manager but it still doesn't
% eliminate the leaks!
%
% Frailties:
% Shared menus retain canvases whose parent could be anything.
% The "fix" is to reparent the canvases.
%
% Interests with null canvases are problematic.
%
% Special behavior of "newcanvas" for framebuffer children is
% annoying, and can't really be fixed completely by redefinition
% owing to autobind.
%
% Shared menus make life interesting since their canvas's parent links
% have to be changed on /popup.
%
% I really don't know why it doesn't work when you have a root piemenu.
% Current "solution" is to change the rootmenu back to regular menu for
% the "winwin."
%
% NeWS Bugs:
% When a window is reshaped, where subwindows are and where they think
% they are are two different things entirely.
%
% Only true root overlay canvases cover their siblings!
%
/WinWin DefaultWindow [ ] classbegin
/IconImage /client def
/PaintIcon {
/PaintIcon super send
IconBorderColor strokecanvas
} def
/FrameLabel (Window Window) def
/ClientMenu null def
/CreateClientCanvas {
/ClientCanvas FrameCanvas newcanvas def
/ptr /ptr_m ClientCanvas setstandardcursor
ClientCanvas begin
/Transparent false def
/Retained false def
/EventsConsumed /AllEvents def
/Mapped true def
end
} def
/PaintFrameBorder { % - => - (Paint frame border areas)
clippath pathbbox rectpath
BorderLeft .5 sub BorderBottom .5 sub
FrameWidth BorderLeft BorderRight add sub 1 add
FrameHeight BorderBottom BorderTop add sub 1 add
FramePath gsave FrameFillColor setshade eofill grestore
FrameBorderColor setshade stroke FrameBorderColor strokecanvas
} def
/ForkFrameEventMgr {
/FrameEventMgr FrameInterests forkeventmgr def
} def
/destroy {
createevent dup begin
/Name /DoItEvent def
/Action /Window def
/ClientData [
% /EventMgrDict cvx /CurrentEvent null /put cvx % GC leak
ClientCanvas /framebuffer cvx /eq cvx { destroy } /if cvx
] cvx def
end sendevent
% save some memory in case of GC leaks:
ClientCanvas /Retained false put
FrameCanvas /Retained false put
% Kill some processes:
/KillProcesses where {
/KillProcesses get { killprocess } forall
/KillProcesses null store
} if
% Kill some groups:
/KillGroups where {
/KillGroups get { killprocessgroup } forall
/KillGroups null store
} if
% console (OK!\n) writestring console flushfile
/destroy super send
} def
% we only drag the frame since draging the canvas doesn't work too
% well when there are opaque children
/slide { % - => - (Interactively move window)
{
Iconic? { /slide super send } {
GetCanvas setcanvas
InteractionLock { true dragcanvas } monitor
currentcanvas ParentCanvas setcanvas getcanvaslocation
/move self send
} ifelse
} fork pop
} def
classend systemdict 3 1 roll put
/copymenu { % - => newmenu -- a phony menu method
self dup maxlength dict copy end begin
/MenuCanvas null def
/MenuWidth null def
/MenuEventMgr null def
/ChildMenu null def
/MenuActions MenuActions dup length array copy def
/MenuKeys MenuKeys dup length array copy def
/MenuItems MenuItems dup length array copy def
0 1 MenuActions length 1 sub { % for
dup getmenuaction
dup type { % case(type) -- i menuaction
/dicttype {
/copymenu exch send % copy i menu'
MenuActions 2 index 2 index put
MenuItems 2 index MenuKeys
1 index get 3 index MakeMenuItem put
}
/arraytype { dup xcheck {
systemdict /forkunix get /forkunix cvx rebindit
} if }
} case
pop pop
} for
currentdict end
} def
/flipstyle { % - => newmenu
0 1 MenuActions length 1 sub {
dup getmenuaction % fixed to use getmenuaction!
dup type /dicttype eq {
/flipstyle exch send % i menu'
MenuActions 3 1 roll put % -
} {pop pop} ifelse
} for
MenuKeys MenuActions /new DefaultMenu send
} def
currentdict framebuffer { begin } pop end % pop user dict
50 dict begin % The things we do for recursive WinWins!
/framebuffer exch def
/fboverlay framebuffer createoverlay def
/newcanvas {
dup framebuffer eq exch
systemdict /newcanvas get exec
exch {
dup /Transparent false put
dup /Color get not { dup /Retained true put } if
} if
} def
/win framebuffer /new WinWin send def
/reshapefromuser win send
/map win send
win
/win null def
end
exch begin { end } pop /win exch def
% systemdict /foo win put % pseudo-scientific visualizer
systemdict /NextSocket known not { systemdict /NextSocket 2011 put } if
/ServerSocket systemdict begin
NextSocket /NextSocket NextSocket 1 add def
end def
/FakeServer (NEWSSERVER) getenv
(;) search pop exch pop (.) search pop exch pop exch % sys addr port
pop ServerSocket 20 string cvs
(.) exch append append exch (;) exch append append def
/rebindit { % proc key val => proc
2 index % proc key val proc
&rebindit pop pop
} def
/&rebindit { % key val proc => key val
dup length 0 1 3 2 roll 1 sub { % key val proc 0 1 lng-1 { ... } for
2 copy get % key val proc ix proc[ix]
dup type /arraytype eq { % another proc?
exch pop exch 4 1 roll % proc key val proc[ix]
&rebindit 3 -1 roll % key val proc
} { % key val
dup xcheck { % executable
4 index eq { % ... and same as key?
% key val proc ix
1 index exch 3 index put % key val proc
} {
pop
} ifelse
} {
pop pop
} ifelse
} ifelse
} for
pop
} def
/Hacks dictbegin
/framebuffer win /ClientCanvas get def
/fboverlay framebuffer createoverlay def
% /fboverlay { framebuffer createoverlay dup canvastotop } def
/newcanvas {
dup framebuffer eq exch
systemdict /newcanvas get exec
exch {
dup /Transparent false put
dup /Color get not { dup /Retained true put } if
} if
} def
% note: we have to patch LiteWindow because newcanvas was autobound
% and consequently the above definition has no effect.
LiteWindow /CreateFrameCanvas get
systemdict /newcanvas get /newcanvas cvx rebindit pop
LiteWindow /CreateIconCanvas get
systemdict /newcanvas get /newcanvas cvx rebindit pop
% Likewise, LiteWindow ParentCanvas is defined as framebuffer in advance.
% We'll fix this by defining it to be { framebuffer }.
LiteMenu /ParentCanvas { framebuffer } put
[
DefaultMenu
/PieMenu where { pop PieMenu dup DefaultMenu eq { pop } if } if
] { % forall
{ % loop
dup null eq { pop exit } if
dup /showat known {
dup /showat get systemdict /newcanvas get /newcanvas cvx
rebindit % classdict showatproc
0 get /CheckParent ne {
dup /showat 2 copy get
{ CheckParent } {} modifyproc put
} if
dup /CheckParent {
MenuCanvas null ne {
MenuCanvas /Parent ParentCanvas put
} if
} put
} if
/ParentDict get
} loop
} forall
% This is gross, gross, gross, but we must improve the hygiene of
% the event manager:
/forkeventmgr load 2 get 19 get dup 22 get /repeat load eq {
dup 21 { { pop } repeat EventMgrDict /CurrentEvent null put } put
22 /exec cvx put
} {
pop
} ifelse
/AllWin { % proc => - (Distributes proc to all windows!!)
createevent dup begin
/Name /DoItEvent def
/Action /Window def
/ClientData [
% /EventMgrDict cvx /CurrentEvent null /put cvx % GC leak
framebuffer /framebuffer cvx /eq cvx [
7 index cvx /exec cvx
] cvx /if cvx
] cvx def
end sendevent pop
} def
/^C { % kill the Window of Windows
createevent dup begin
/Name /DoItEvent def
/Action /Window def
/ClientData [
% /EventMgrDict cvx /CurrentEvent null /put cvx % GC leak
framebuffer
{
ClassName /WinWin eq {
ClientCanvas eq { self /destroy exch send } if
} {
pop
} ifelse
} /exec cvx
] cvx def
end sendevent pop
} def
/exitcleanly load systemdict /^C get /^C cvx rebindit pop
/forkunix {
(NEWSSERVER) getenv
(NEWSSERVER) //FakeServer putenv
exch systemdict /forkunix get exec
(NEWSSERVER) exch putenv
} def
dictend def
Hacks /def load forall
framebuffer setcanvas PaintRoot
/rootmenu /copymenu rootmenu send def
/DefaultMenu LitePullRightMenu def /rootmenu /flipstyle rootmenu send def
/serverproc { % fork
clear (%socketl) //ServerSocket 20 string cvs append (r) file
{ % loop
dup mark exch acceptconnection
{ % fork
Hacks end 200 dict begin { def } forall
initmatrix newprocessgroup
exch pop exch pop dup
getsocketpeername /OriginatingHost exch def
RemoteHostRegistry OriginatingHost known
OriginatingHost localhostname anchorsearch
{ pop (.) anchorsearch
{ pop pop RemoteHostRegistry localhostname known }
{ pop false } ifelse }
{ pop false } ifelse or
% Let through if no security wanted
NetSecurityWanted not or
{ cvx exec }
{ currentcursorlocation
[ (Network security violation:)
(Rejected connection from ) OriginatingHost append ]
popmsg } ifelse
currentprocess killprocessgroup
} fork
cleartomark
} loop
} fork def
/rooteventmgr [
/rootmenu where { pop
MenuButton
{ {/showat rootmenu send} fork pop }
DownTransition framebuffer eventmgrinterest
} if
/Damaged { damagepath clipcanvas PaintRoot newpath clipcanvas}
null framebuffer eventmgrinterest
] forkeventmgr def
win /KillProcesses [ serverproc rooteventmgr ] put
% win /KillGroups [ rooteventmgr ] put