#!/usr/NeWS/bin/psh %% $Header: pw.ps,v 1.5 88/07/13 15:17:15 bvs Exp $ % % 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. % This file contains the classes used by the class browser. % The classes included are: % Picture -- an Item similar in concept to the NeWS1.1 textcanvas % PicWindow -- a LiteWindow that holds Pictures % PicScroll -- a SimpleScrollbar with a few modifications (auto scrolling) % % This code was mostly written in August 1987 but was revised to work with % NeWS 1.1 in May 1988. % % Bruce V. Schwartz % Sun Microsystems % bvs@sun.com % /XNeWS? where { pop } { systemdict /XNeWS? false put } ifelse systemdict begin systemdict /Item known not { (NeWS/liteitem.ps) run } if systemdict /SimpleScrollbar known not { (NeWS/liteitem.ps) run } if end %% This file contains classes: PicWindow Picture PicScroll /PicWindow LiteWindow dictbegin /PicArray [] def dictend classbegin /BorderRight 1 def /BorderLeft 1 def /BorderBottom 1 def /PaintIcon { 1 fillcanvas 0 strokecanvas .8 setgray IconWidth 2 div 1 sub IconHeight 4 div 5 sub 5 Sunlogo } def /PaintClient { %% (paint client %\n) [ PicArray ] dbgprintf %% PicArray { ( %\n) [ 3 2 roll ] dbgprintf } forall PicArray paintitems } def /setpicarray { /PicArray exch def } def /destroy { %% (destroying arrays\n) [] dbgprintf PicArray { /destroy exch send } forall %% (destroying window\n) [] dbgprintf /destroy super send %% (destroyed window\n) [] dbgprintf } def classend def /PicScrollbar SimpleScrollbar dictbegin /Owner null def /MouseInItem? false def /ScrollMonitor null def /ScrollProcess null def /ScrollDelay 1 60 div 20 div def % 1/10 second /LastX null def /LastY null def dictend classbegin /ItemShadeColor .5 def /new { /new super send begin /ScrollMonitor createmonitor def currentdict end } def /setowner { /Owner exch def } def /ClientDown { % - => - CurrentEvent begin XLocation YLocation end /LastY exch def /LastX exch def SetScrollMotion /MouseInItem? true def HiliteItem DoScroll ScrollProcess null ne { ScrollMonitor { ScrollProcess killprocess } monitor } if /ScrollProcess { InteractiveScroll } fork pause def } def /InteractiveScroll { { ScrollDelay sleep ScrollMonitor { EventInItem? { DoScroll } if } monitor } loop } def /ClientUp { % - => - % (Clientup\n) [] dbgprintf % ScrollMonitor { ScrollProcess killprocess } monitor /ScrollProcess null def /MouseInItem? false def UnhiliteItem ItemValue ItemInitialValue ne { /Notify Owner send } if } def /ClientDrag { % - => - CurrentEvent begin XLocation YLocation end /LastY exch def /LastX exch def CheckItem } def /PaintBar { } def /EraseBox { } def /PaintButtons { BarViewPercent 1 gt true or { /PaintButtons super send } if } def /PaintBox { % - => - (paint box) %(PaintBox %\n) [ BarViewPercent ] dbgprintf %(pause...) [] dbgprintf 1 60 div sleep (!!\n) [] dbgprintf gsave 10 dict begin /x 1 def /w ItemWidth 1 sub def BarViewPercent 1 le { 1 setgray x ButtonSize w ItemHeight ButtonSize dup add sub rectpath fill } { 1 1 BarViewPercent div sub 1 ItemValue sub mul ItemHeight ButtonSize dup add sub mul ButtonSize add /y exch def 1 BarViewPercent div ItemHeight ButtonSize dup add sub mul /h exch def % % do the normal bar % ItemFillColor setcolor x ButtonSize w y ButtonSize sub rectpath fill x y h add w ItemHeight ButtonSize sub y sub h sub rectpath fill % % do the big scroll box % /ybut ItemValue ValueToY def ItemShadeColor setgray x y w ybut y sub rectpath fill x ybut ButtonSize add w h ButtonSize sub ybut sub y add rectpath fill % % do the little scroll box % ItemValue BoxPath BoxFillColor setcolor gsave fill grestore } ifelse end /ItemPaintedValue ItemValue def grestore /Notify Owner send } def /EventInItem? { % - => bool ScrollMotion { /ScrollAbsolute { false } /ScrollPageForward % top { LastX dup 0 ge exch ButtonSize le LastY ItemValue ValueToY ButtonSize add ge LastY ItemHeight ButtonSize sub le and and and } /ScrollPageBackward % bottom { LastX dup 0 ge exch ButtonSize le LastY ButtonSize ge LastY ItemValue ValueToY le and and and } /ScrollLineForward % top { LastX 0 ge LastX ButtonSize le LastY ItemHeight ButtonSize sub ge LastY ItemHeight le and and and } /ScrollLineBackward % bottom { LastX 0 ge LastX ButtonSize le LastY 0 ge LastY ButtonSize le and and and } } case BarViewPercent 1 le { pop false } if } def /CheckItem { ScrollMotion { /ScrollAbsolute {DoScroll} /ScrollPageForward % top { /MouseInItem? EventInItem? def } /ScrollPageBackward % bottom { /MouseInItem? EventInItem? def } /ScrollLineForward % top { EventInItem? dup { MouseInItem? not { HiliteItem } if } { MouseInItem? { UnhiliteItem } if } ifelse /MouseInItem? exch def } /ScrollLineBackward % bottom { EventInItem? dup { MouseInItem? not { HiliteItem } if } { MouseInItem? { UnhiliteItem } if } ifelse /MouseInItem? exch def } } case } def /HiliteItem { ScrollMotion { /ScrollAbsolute { } /ScrollPageForward { } /ScrollPageBackward { } /ScrollLineForward % top { 0 ItemHeight ButtonSize ButtonSize neg rectpath 5 setrasteropcode fill } /ScrollLineBackward % bottom { 0 0 ButtonSize ButtonSize rectpath 5 setrasteropcode fill } } case } def /UnhiliteItem { gsave ScrollMotion { /ScrollAbsolute {} /ScrollPageForward {} /ScrollPageBackward {} /ScrollLineForward % top { 0 ItemHeight ButtonSize sub ButtonSize ButtonSize rectpath clip PaintButtons } /ScrollLineBackward % bottom { 0 0 ButtonSize ButtonSize rectpath clip PaintButtons } } case grestore } def classend def /Picture Item dictbegin /BufferCanvas null def /BufferWidth 0 def /BufferHeight 0 def /HScrollbar null def /VScrollbar null def /HScrollbar? true def /VScrollbar? true def /HScrollWidth 0 def /VScrollWidth 0 def /ScrollWidth 16 def /NotifyUserDown { pop pop } def % x y => - /NotifyUserUp { pop pop } def % x y => - /NotifyUserDrag { pop pop } def % x y => - /NotifyUserEnter { pop pop } def % x y => - /NotifyUserExit { pop pop } def % x y => - dictend classbegin /new { % parentcanvas width height => instance % (new begin\n) [] dbgprintf /new super send begin /BufferHeight ItemHeight def /BufferWidth ItemWidth def CreateScrollbars CreateBuffer currentdict end % (new end\n) [] dbgprintf } def /destroy { HScrollbar null ne { null /setowner HScrollbar send } if VScrollbar null ne { null /setowner VScrollbar send } if %% BufferCanvas /Mapped false put %% /BufferCanvas null def } def /reshape { % x y w h => - /reshape super send ReshapeScrollbars } def /reshapebuffer { % w h => - /BufferHeight exch ItemHeight HScrollbar? { HScrollWidth sub } if max def /BufferWidth exch ItemWidth VScrollbar? { VScrollWidth sub } if max def ReshapeBuffer ReshapeScrollbars } def /getcanvas { BufferCanvas } def /updatecanvas { PaintBuffer } def /makestartinterests { /makestartinterests HScrollbar send /makestartinterests VScrollbar send [ exch aload length 2 add -1 roll aload pop ] % join 2 arrays /makestartinterests super send [ exch aload length 2 add -1 roll aload pop ] % join 2 arrays } def /PaintItem { %% (PaintItem begin\n) [] dbgprintf PaintBuffer /paint VScrollbar send /paint HScrollbar send %% (PaintItem end\n) [] dbgprintf } def /Notify { % (picture got notified\n) [] dbgprintf NotifyUser PaintBuffer } def /PaintBuffer { % (PaintBuffer begin \n) [ ] dbgprintf gsave ItemCanvas setcanvas % % Stroke canvas % 0 setgray 0 HScrollWidth ItemWidth VScrollWidth sub ItemHeight HScrollWidth sub rectpath stroke % % compute clipping region % 1 HScrollWidth 1 add ItemWidth VScrollWidth sub 2 sub ItemHeight HScrollWidth sub 2 sub rectpath % (clip to % % % %\n) [ pathbbox ] dbgprintf clip % % compute translation % BufferWidth ItemWidth sub VScrollWidth add neg dup 0 lt { 1 /getvalue HScrollbar send sub mul } { pop 0 } ifelse BufferHeight ItemHeight sub HScrollWidth add neg dup 0 lt { 1 /getvalue VScrollbar send sub mul } { } ifelse HScrollWidth add % 2 copy (translate by % %\n) [ 4 2 roll ] dbgprintf translate XNeWS? not { BufferWidth BufferHeight % 2 copy (scale by % %\n) [ 4 2 roll ] dbgprintf scale } if % (currentmatrix % % % % % %\n) [ matrix currentmatrix aload pop ] dbgprintf pause BufferCanvas imagecanvas pause grestore % (PaintBuffer end\n) [ ] dbgprintf } def /CreateBuffer { % - => - /BufferCanvas framebuffer newcanvas def BufferCanvas /Retained true put % BufferCanvas /Mapped true put ReshapeBuffer } def /ReshapeBuffer { % - => - gsave framebuffer setcanvas 0 0 BufferWidth BufferHeight rectpath BufferCanvas reshapecanvas grestore } def /CreateScrollbars { % - => - % (begin CreateScrollbars\n) [] dbgprintf /HScrollWidth HScrollbar? { ScrollWidth } { 0 } ifelse def /VScrollWidth VScrollbar? { ScrollWidth } { 0 } ifelse def ItemWidth VScrollWidth le { /VScrollWidth ScrollWidth 2 div def } if ItemHeight HScrollWidth le { /HScrollWidth ScrollWidth 2 div def } if /HScrollbar [1 0 .01 .1 BufferWidth ItemWidth VScrollWidth sub div ] 1 {} ItemCanvas /new PicScrollbar send dup /BarVertical? false put def /VScrollbar [1 0 .01 .1 BufferHeight ItemHeight HScrollWidth sub div ] 1 {} ItemCanvas /new PicScrollbar send def self /setowner HScrollbar send self /setowner VScrollbar send % (end CreateScrollbars\n) [] dbgprintf } def /ReshapeScrollbars { /HScrollWidth HScrollbar? { ScrollWidth } { 0 } ifelse def /VScrollWidth VScrollbar? { ScrollWidth } { 0 } ifelse def 10 dict begin /h ItemHeight def /w ItemWidth def /s ScrollWidth def [1 0 .01 .1 BufferWidth ItemWidth VScrollWidth sub div ] /setrange HScrollbar send [1 0 .01 .1 BufferHeight ItemHeight HScrollWidth sub div ] /setrange VScrollbar send HScrollbar? { 0 0 w VScrollWidth sub s } { 0 0 0 0 } ifelse % 4 copy (hscroll % % % %\n) [ 6 2 roll ] dbgprintf /reshape HScrollbar send VScrollbar? { w s sub HScrollWidth s h HScrollWidth sub } { 0 0 0 0 } ifelse % 4 copy (vscroll % % % %\n) [ 6 2 roll ] dbgprintf /reshape VScrollbar send end } def /ClientDown { % (Picture ClientDown\n) [] dbgprintf % compute translation % BufferWidth ItemWidth sub VScrollWidth add neg dup 0 lt { 1 /getvalue HScrollbar send sub mul } { pop 0 } ifelse BufferHeight ItemHeight sub HScrollWidth add neg dup 0 lt { 1 /getvalue VScrollbar send sub mul } { } ifelse HScrollWidth add % translatex translatey CurrentEvent /YLocation get sub neg exch CurrentEvent /XLocation get sub neg exch % (n: %\n) [ NotifyUserDown ] dbgprintf { NotifyUserDown } fork } def /ClientUp { % (Picture ClientUp\n) [] dbgprintf CurrentEvent begin XLocation YLocation end NotifyUserUp } def /ClientDrag { % (client drag\n) [] dbgprintf CurrentEvent begin XLocation YLocation end NotifyUserDrag } def /ClientEnter { %% (client enter\n) [] dbgprintf CurrentEvent begin XLocation YLocation end NotifyUserEnter } def /ClientExit { %% (client exit\n) [] dbgprintf CurrentEvent begin XLocation YLocation end NotifyUserExit } def classend def %% $Header: browseclass.ps,v 1.4 88/07/13 15:17:06 bvs Exp $ % % 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. % % This file contains a NeWS server class browser. % % The browser is built on the classes defined in pw.ps. The class % browser has 5 panes. It is similar in appearance to the Smalltalk % browser. The first pane on the top of the window contains the list of % classes in the server. The next 3 contain the list of methods, class % variables, and instance variables associated with the selected class in % the first pane. The bottom pane is used to display information about % the current selection. % % This code was mostly written in August 1987 but was revised to work with % NeWS 1.1 in May 1988. % % Many changes in November 1988. Integrated several of Richard Hess's % improvements. New features include improved scrolling, caching of browsed % classes, addition of the NoClass class for browsing the systemdict, better % decompilation of dictionaries, and process control (new request cancels % previous, better error handling, and looks better on B/W screen. % % Bruce V. Schwartz % Sun Microsystems % bvs@sun.com % % % If you don't use the "browse" script, you will have to alter the % following line to reflect the location of the file "pw.ps" on your % system. % /PicWindow where { pop } { systemdict begin (NeWS/pw.ps) LoadFile pop end } ifelse /Font15 /Times-Roman findfont 15 scalefont def /PickProcess null def /PicArray [ ] def /win framebuffer /new PicWindow send def { /FrameLabel (NeWS Class Browser) def } /doit win send /can win /ClientCanvas get def /LastClassPick null def /LastInstPick null def /LastMethodPick null def /LastVarPick null def /ClassKeys [] def /InstKeys [] def /MethodKeys [] def /VarKeys [] def /W 200 def /H 300 def /TextW 800 def /TextH 300 def 100 100 TextW TextH H add 16 add /reshape win send /ClassPic win /ClientCanvas get W H /new Picture send def % classes /MethodPic win /ClientCanvas get W H /new Picture send def % methods /VarPic win /ClientCanvas get W H /new Picture send def % class var /InstPic win /ClientCanvas get W H /new Picture send def % ints var /TextPic win /ClientCanvas get TextW TextH /new Picture send def % text /PicArray [ ClassPic InstPic MethodPic VarPic TextPic ] def PicArray /setpicarray win send ClassPic /HScrollbar? false put InstPic /HScrollbar? false put MethodPic /HScrollbar? false put VarPic /HScrollbar? false put TextPic /HScrollbar? false put 000 TextH W H /reshape ClassPic send 200 TextH W H /reshape MethodPic send 400 TextH W H /reshape VarPic send 600 TextH W H /reshape InstPic send 0 0 TextW TextH /reshape TextPic send 0 /setvalue ClassPic /VScrollbar get send 0 /setvalue InstPic /VScrollbar get send 0 /setvalue MethodPic /VScrollbar get send 0 /setvalue VarPic /VScrollbar get send 0 /setvalue TextPic /VScrollbar get send /ClassColor 1 .8 .8 rgbcolor def /InstColor 1 .8 1 rgbcolor def /MethodColor .8 1 .8 rgbcolor def /VarColor .8 .8 1 rgbcolor def /TextColor 1 1 1 rgbcolor def ClassPic /NotifyUserDown { { ClassPick } HandlePick } put InstPic /NotifyUserDown { { InstPick } HandlePick } put MethodPic /NotifyUserDown { { MethodPick } HandlePick } put VarPic /NotifyUserDown { { VarPick } HandlePick } put %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Utilities for expanding NeWS object types /String256 256 string def /Expand % thing -> - { ExpandDict begin 10 dict begin /ArrayDepth 0 def /TabWidth ( ) stringwidth pop def () exch dup type exec end end } def /StartArray % string array -> string (string) array { /tmparray exch def StartLine ([) AddString /tmparray load /ArrayDepth ArrayDepth 1 add def } def /EndArray % string -> string (string) { /ArrayDepth ArrayDepth 1 sub def (] ) append StartLine } def /StartXArray % string array -> string (string) array { /tmparray exch def StartLine ({) AddString /tmparray load /ArrayDepth ArrayDepth 1 add def } def /EndXArray % string -> string (string) { /ArrayDepth ArrayDepth 1 sub def (} ) append StartLine } def /StartLine % string -> string (string) { dup stringwidth pop TabWidth ArrayDepth mul gt { () ArrayDepth { ( ) append } repeat } if } def /AddString % string string -> string (string) { append ( ) append dup stringwidth pop 700 gt { StartLine } if pause } def /ExpandDict 20 dict dup begin /arraytype { dup xcheck { StartXArray { dup type exec } forall EndXArray } { StartArray { dup type exec } forall EndArray } ifelse } def /dicttype { /tmp exch def StartLine (<>) AddString StartLine tmp { /tmp exch def dup type exec ( ) AddString /tmp load dup type dup /dicttype eq { pop pop (***Dictionary***) AddString } % no recursion here! { exec } ifelse StartLine } forall StartLine (<>) AddString StartLine } def /booleantype { String256 cvs AddString} def /filetype { String256 cvs AddString} def /fonttype { String256 cvs AddString} def /integertype { String256 cvs AddString} def /marktype { ([ ) AddString} def /nametype { dup String256 cvs exch xcheck not { (/) exch append } if AddString } def /nulltype { String256 cvs AddString} def /operatortype { String256 cvs dup length 2 sub 1 exch getinterval AddString} def /realtype { String256 cvs AddString} def /savetype { String256 cvs AddString} def /stringtype { String256 cvs (\() exch append (\)) append AddString} def %% NeWS types /canvastype { String256 cvs AddString} def /colortype { String256 cvs AddString} def /eventtype { String256 cvs AddString} def /graphicsstatetype { String256 cvs AddString} def /monitortype { String256 cvs AddString} def /processtype { String256 cvs AddString} def /shapetype { String256 cvs AddString} def end def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Sorting Utilities /FindSmall % proc array -> int { 10 dict begin /a exch def /proc exch def /result 0 def /key a 0 get def /i 0 def 0 1 a length 1 sub { /j exch def key a j get proc { /i j def /key a j get def } if } for i end } def /FasterSort % proc array -> array { 10 dict begin /arrayin exch def /arrayout [] def /proc exch def { arrayin length 0 eq { arrayout exit } if /proc load arrayin FindSmall /i exch def arrayout arrayout length arrayin i get arrayinsert /arrayout exch def /arrayin arrayin i arraydelete def pause } loop end } def /Sort % array -> array { { gt } exch FasterSort } def /BubbleSort % array -> array { 20 dict begin /keys exch def /bound keys length 1 sub def /check 0 def { /t -1 def 0 1 bound 1 sub { /i exch def /j i 1 add def /keysi keys i get def /keysj keys j get def keysi keysj gt { keys i keysj put keys j keysi put /t j def } if } for t -1 eq { exit } { /bound t def } ifelse pause } loop keys end %% EndWait } def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Main Class code /ShowArray { % array color pic % (showarray: count %\n) [ count ] dbgprintf 10 dict begin /pic exch def /color exch def /a exch def Font15 setfont W a length 18 mul 15 add /reshapebuffer pic send % { /paint VScrollbar send /paint HScrollbar send } pic send /getcanvas pic send setcanvas color fillcanvas mark /PaintItem pic send cleartomark % PaintItem seems to leave 2 things on the stack 0 0 0 rgbcolor setcolor /k pic /BufferHeight get def a { /k k 18 sub def 5 k moveto show } forall /updatecanvas pic send end } def /DoClasses { [ systemdict { /val exch cvlit def /key exch cvlit def val type /dicttype eq { val /ClassName known { key val /ClassName get eq { % leave this on the stack key 256 string cvs } if } if } if pause } forall ] Sort userdict begin /ClassKeys exch def end ClassKeys ClassColor ClassPic ShowArray userdict /ClassesDict ClassKeys length dict put [] MethodColor MethodPic ShowArray [] VarColor VarPic ShowArray [] InstColor InstPic ShowArray [] TextColor TextPic ShowArray % fork off a process to fill the ClassesDict for % all classes { ClassKeys { DoClass } forall } fork } def /DoClass % classname -> - (sorts all class attributes) { 10 dict begin /classname exch def ClassesDict classname known not { /classarrays 3 dict def /classdict systemdict classname get def classdict GetSortedMethods classdict GetSortedClassVars classdict GetSortedInstVars classarrays begin /InstVars exch def /ClassVars exch def /Methods exch def end ClassesDict classname classarrays put } if end } def /GetSortedMethods { % classdict => - [ exch { /val exch def /key exch def /val load type /arraytype eq /val load xcheck and { key 256 string cvs } if pause } forall ] Sort } def /GetSortedClassVars { % classdict => - [ exch { /val exch def /key exch def /val load type { /arraytype { /val load xcheck not } /operatortype { false } /dicttype { /val load /ClassName known not } /Default { true } } case { key 256 string cvs } if pause } forall ] Sort } def /GetSortedInstVars { % classdict => - [ exch /InstanceVarDict get dup null eq { pop [] } if { /val exch def /key exch def key 256 string cvs pause } forall ] Sort } def /DoMethods % classname => - { ClassesDict exch get /Methods get userdict begin /MethodKeys exch def end MethodKeys MethodColor MethodPic ShowArray } def /DoVars % classname => - { ClassesDict exch get /ClassVars get userdict begin /VarKeys exch def end VarKeys VarColor VarPic ShowArray } def /DoInsts % classname => - { ClassesDict exch get /InstVars get userdict begin /InstKeys exch def end InstKeys InstColor InstPic ShowArray } def /ClassPick % x y => - { 10 dict begin /y exch def /x exch def /k ClassPic /BufferHeight get y sub 18 div floor def /lastpick LastClassPick def userdict /LastClassPick k put Font15 setfont lastpick null ne { null SetMethodPick null SetVarPick null SetInstPick gsave %(unhilite %\n) [ lastpick ] dbgprintf /getcanvas ClassPic send setcanvas 0 ClassPic /BufferHeight get lastpick 1 add 18 mul sub 3 sub W 18 rectpath ClassColor setcolor fill 0 0 0 rgbcolor setcolor 5 ClassPic /BufferHeight get lastpick 1 add 18 mul sub moveto ClassKeys lastpick get show grestore } if lastpick null ne lastpick k ne and { %% put scroll bars back to top 0 /setvalue InstPic /VScrollbar get send 0 /setvalue MethodPic /VScrollbar get send 0 /setvalue VarPic /VScrollbar get send 0 /setvalue TextPic /VScrollbar get send } if %(pick is % \n ) [ k ] dbgprintf k ClassKeys length 1 sub le { % (pick is % '%' \n ) [ ClassKeys k get k ] dbgprintf % (Lastpick was '%' \n ) [ lastpick ] dbgprintf /getcanvas ClassPic send setcanvas %(hilite %\n) [ k ] dbgprintf 0 ClassPic /BufferHeight get k 1 add 18 mul sub 3 sub W 18 rectpath 0 0 0 rgbcolor setcolor fill ClassColor setcolor 0 5 ClassPic /BufferHeight get k 1 add 18 mul sub moveto ClassKeys k get show /updatecanvas ClassPic send lastpick k ne { [(Loading Menus...)] TextColor TextPic ShowArray [] MethodColor MethodPic ShowArray [] VarColor VarPic ShowArray [] InstColor InstPic ShowArray } if lastpick k ne { ClassKeys k get cvn dup DoClass dup DoMethods dup DoVars dup DoInsts pop } if [ (CLASS ") ClassKeys k get 256 string cvs (") append append systemdict ClassKeys k get cvn get /ParentDictArray known { systemdict ClassKeys k get cvn get /ParentDictArray get { /ClassName get 256 string cvs ( ) exch append } forall } if ] TextColor TextPic ShowArray k } { /updatecanvas ClassPic send null } ifelse end } def /SetInstPick % newpick => - { 10 dict begin Font15 setfont LastInstPick null ne { gsave /getcanvas InstPic send setcanvas 0 InstPic /BufferHeight get LastInstPick 1 add 18 mul sub 3 sub W 18 rectpath InstColor setcolor fill 0 0 0 rgbcolor setcolor 5 InstPic /BufferHeight get LastInstPick 1 add 18 mul sub moveto InstKeys LastInstPick get show grestore } if userdict begin /LastInstPick exch def end % pick up newpick %% (new InstPick is % \n ) [ LastInstPick ] dbgprintf LastInstPick null ne { /getcanvas InstPic send setcanvas 0 InstPic /BufferHeight get LastInstPick 1 add 18 mul sub 3 sub W 18 rectpath 0 0 0 rgbcolor setcolor fill InstColor setcolor 0 5 InstPic /BufferHeight get LastInstPick 1 add 18 mul sub moveto InstKeys LastInstPick get show } if /updatecanvas InstPic send LastInstPick null ne { /val systemdict ClassKeys LastClassPick get cvn get % class /InstanceVarDict get % instdict InstKeys LastInstPick get % class variable get def [] TextColor TextPic ShowArray [ (INSTANCE VARIABLE) ( ") InstKeys LastInstPick get 256 string cvs (") append append append val Expand ] TextColor TextPic ShowArray } if end } def /InstPick { null SetMethodPick null SetVarPick 10 dict begin /y exch def /x exch def /k InstPic /BufferHeight get y sub 18 div floor def %% (pick is % \n ) [ k ] dbgprintf k dup end InstKeys length 1 sub le { SetInstPick } { pop } ifelse } def /SetMethodPick % newpick => - { Font15 setfont LastMethodPick null ne { gsave /getcanvas MethodPic send setcanvas 0 MethodPic /BufferHeight get LastMethodPick 1 add 18 mul sub 3 sub W 18 rectpath MethodColor setcolor fill 0 0 0 rgbcolor setcolor 5 MethodPic /BufferHeight get LastMethodPick 1 add 18 mul sub moveto MethodKeys LastMethodPick get show grestore } if userdict begin /LastMethodPick exch def end % pick up newpick %% (new MethodPick is % \n ) [ LastMethodPick ] dbgprintf LastMethodPick null ne { /getcanvas MethodPic send setcanvas 0 MethodPic /BufferHeight get LastMethodPick 1 add 18 mul sub 3 sub W 18 rectpath 0 0 0 rgbcolor setcolor fill MethodColor setcolor 0 5 MethodPic /BufferHeight get LastMethodPick 1 add 18 mul sub moveto MethodKeys LastMethodPick get show } if /updatecanvas MethodPic send LastMethodPick null ne { [] TextColor TextPic ShowArray [ (METHOD ") MethodKeys LastMethodPick get 256 string cvs (") append append systemdict ClassKeys LastClassPick get cvn get % class MethodKeys LastMethodPick get % class method get Expand ] TextColor TextPic ShowArray } if } def /MethodPick { null SetVarPick null SetInstPick 10 dict begin /y exch def /x exch def /k MethodPic /BufferHeight get y sub 18 div floor def %% (pick is % \n ) [ k ] dbgprintf k dup end MethodKeys length 1 sub le { SetMethodPick } { pop } ifelse } def /SetVarPick % newpick => - { 10 dict begin Font15 setfont LastVarPick null ne { gsave /getcanvas VarPic send setcanvas 0 VarPic /BufferHeight get LastVarPick 1 add 18 mul sub 3 sub W 18 rectpath VarColor setcolor fill 0 0 0 rgbcolor setcolor 5 VarPic /BufferHeight get LastVarPick 1 add 18 mul sub moveto VarKeys LastVarPick get show grestore } if userdict begin /LastVarPick exch def end % pick up newpick %% (new VarPick is % \n ) [ LastVarPick ] dbgprintf LastVarPick null ne { /getcanvas VarPic send setcanvas %(hilite %\n) [ LastVarPick ] dbgprintf 0 VarPic /BufferHeight get LastVarPick 1 add 18 mul sub 3 sub W 18 rectpath 0 0 0 rgbcolor setcolor fill VarColor setcolor 0 5 VarPic /BufferHeight get LastVarPick 1 add 18 mul sub moveto VarKeys LastVarPick get show } if /updatecanvas VarPic send LastVarPick null ne { /val systemdict ClassKeys LastClassPick get cvn get % class VarKeys LastVarPick get % class variable get def [] TextColor TextPic ShowArray [ { (CLASS VARIABLE) ( ") VarKeys LastVarPick get 256 string cvs (") append append append val Expand } errored { cleartomark [ (CLASS VARIABLE) ( ") VarKeys LastVarPick get 256 string cvs (") append append append (Error in CLASS VARIABLE) () $error Expand } if ] TextColor TextPic ShowArray } if end } def /VarPick { null SetMethodPick null SetInstPick 10 dict begin /y exch def /x exch def /k VarPic /BufferHeight get y sub 18 div floor def % (pick is % %\n ) [ k VarKeys] dbgprintf k dup end VarKeys length 1 sub le { SetVarPick } { pop } ifelse } def /SetupNoClass { % - -> - Set up systemdict to look like a class systemdict /NoClass systemdict put NoClass /InstanceVarDict 0 dict put systemdict /ClassName (NoClass) put } def /HandlePick { % procedure -> - PickProcess null ne { PickProcess killprocess } if fork userdict begin /PickProcess exch def end } def SetupNoClass DoClasses PicArray forkitems pop /map win send