[comp.windows.news] Enhanced NeWS class browser... Part 1-2

rhess@cimshop.UUCP (Richard Hess) (11/02/88)

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	liteBrowser
#	liteBrowser.ps
# This archive created: Tue Nov  1 08:55:56 1988
export PATH; PATH=/bin:$PATH
echo shar: extracting "'liteBrowser'" '(240 characters)'
if test -f 'liteBrowser'
then
	echo shar: will not over-write existing file "'liteBrowser'"
else
sed 's/^%//' << \SHAR_EOF > 'liteBrowser'
%:
%# [ liteBrowser ]
%#   original:	rhess
%# -----------------------------------------------------------------------------
%
%echo "(NeWS/liteBrowser.ps)run" | psh
%
%# ------------------------------------------------------------------------<eof>
SHAR_EOF
chmod +x 'liteBrowser'
fi # end of overwriting check
echo shar: extracting "'liteBrowser.ps'" '(18617 characters)'
if test -f 'liteBrowser.ps'
then
	echo shar: will not over-write existing file "'liteBrowser.ps'"
else
sed 's/^%//' << \SHAR_EOF > 'liteBrowser.ps'
%% [ liteBrowser.ps ]
%%   modified:	rhess [ 6-16-88 ]
%% -----------------------------------------------------------------------------
%%% $Header: browse.ps,v 1.2 88/06/14 17:17:45 bvs Locked $
%% -----------------------------------------------------------------------------
%%
%%  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.  Feel free to use it as you will.
%%
%%  Bruce V. Schwartz
%%  Sun Microsystems
%%  bvs@sun.com
%% -----------------------------------------------------------------------------
%
%userdict begin
%
%/BrowserPopup						%	[ rhess ]
%	200 200
%	[ (liteBrowser:)
%	  (  NeWS Class Browser... )
%	  (  [ rhess ])
%	] popmsg def
%
%userdict /PicWindow known not { (NeWS/litePicWin.ps) run } if	
%
%/Font15 /Times-Roman findfont 15 scalefont def
%
%/StartWait {
%    userdict begin
%    /SaveCursor [ currentcanvas getcanvascursor ] def
%    /hourg /hourg_m fboverlay setstandardcursor
%    end
%} def
%
%/EndWait {
%    userdict begin
%    SaveCursor aload pop setcanvascursor
%    end
%} def
%
%/DoubleBubbleSort     % keyarray valuearray => - (sorts in place)
%{
%    %% 2 copy (double % %\n) [ 4 2 roll ] dbgprintf
%    %% StartWait
%    20 dict begin
%        /values exch def
%        /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
%                    /valuesi values i get cvlit def
%                    /valuesj values j get cvlit def
%                    values i valuesj put
%                    values j valuesi put
%                    /t j def
%                } if
%            } for
%            t -1  eq 
%                { exit }
%                { /bound t def }
%            ifelse
%            pause
%        } loop
%    end
%    %% EndWait
%} def
%
%/CreateBrowser {	% - => -				[ rhess ]
%    /PicArray [ ] def
%    /win framebuffer /new PicWindow send def
%    {
%	/MenuProc { SetupBrowser } def
%        /FrameLabel (NeWS Class Browser...) def
%    } /doit win send
%    100 100 806 520 /reshape win send
%    { 7 ([ Reset ]) { SetupBrowser } /insertitem FrameMenu send } win send
%    /map win send
%
%    /ClassKeys 	[] def
%    /InstKeys 	[] def
%    /MethodKeys	[] def
%    /VarKeys 	[] def
%
%    /ClassPic   win /ClientCanvas get 300 1000 /new PicItem send def
%    /MethodPic  win /ClientCanvas get 300 1000 /new PicItem send def
%    /VarPic     win /ClientCanvas get 300 1000 /new PicItem send def
%    /InstPic    win /ClientCanvas get 300 1000 /new PicItem send def
%    /TextPic    win /ClientCanvas get 800  600 /new PicItem send def
%
%    [ ClassPic MethodPic VarPic InstPic ]
%    { { /BufferMin 255 def } exch send } 
%    forall
%    { /BufferMin 255 def } TextPic send
%
%    /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 250 200 250 /reshape ClassPic send
%    200 250 200 250 /reshape MethodPic send
%    400 250 200 250 /reshape VarPic send
%    600 250 200 250 /reshape InstPic send
%    0   0   800 250 /reshape TextPic 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 	.8 .8 .8 rgbcolor def	[ orig. ]...
%    /TextColor 		1 1 1 rgbcolor def
%
%    ClassPic	/NotifyUserDown { userdict /ClassPick get exec } put
%    InstPic 	/NotifyUserDown { userdict /InstPick get exec } put
%    MethodPic 	/NotifyUserDown { userdict /MethodPick get exec } put
%    VarPic 	/NotifyUserDown { userdict /VarPick get exec } put
%
%    /BrowserMgr 	null def
%    SetupBrowser
%} def
%
%/SetupBrowser {		% - => -				[ rhess ]
%    LastClassPick null ne	{ /LastClassPick null store } if
%    LastInstPick null ne	{ null SetInstPick } if
%    LastMethodPick null ne	{ null SetMethodPick } if
%    LastVarPick null ne		{ null SetVarPick } if
%
%    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 ClassPic ShowArray
%    [] MethodColor MethodPic ShowArray
%    [] VarColor VarPic ShowArray
%    [] InstColor InstPic ShowArray
%    [] 0.8 0.8 0.8 rgbcolor TextPic ShowArray
%
%    gsave
%      Font15 setfont
%      0 setgray
%      InstPic /ItemCanvas get setcanvas
%        5 230 moveto (Class Insts) show
%      MethodPic /ItemCanvas get setcanvas
%        5 230 moveto (Class Methods) show
%      VarPic /ItemCanvas get setcanvas
%        5 230 moveto (Class Vars) show
%      TextPic /ItemCanvas get setcanvas
%        5 230 moveto (Text) show
%    grestore
%
%    BrowserMgr null eq
%    { /BrowserMgr PicArray forkitems def }
%    if
%
%    /ArrayDepth 0 def
%    DoClasses
%} def
%
%/ShowArray {    % array color pic
%    10 dict begin
%        /pic exch def
%        /color exch def
%        /a exch def
%
%        Font15 setfont
%	[ /BufferWidth cvx 
%	  a length 18 mul 15 add /BufferMin cvx /max cvx 
%	  /reshapebuffer cvx ] cvx
%	pic send
%	{ /paint VScrollbar send
%	  /paint HScrollbar send }
%	pic send
%
%        /getcanvas pic send setcanvas
%        color fillcanvas
%
%        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 {
%    /getcanvas ClassPic send setcanvas
%    10 dict    begin
%        /ClassKeys [] def
%        /ClassVals [] def
%
%        [ systemdict userdict ]
%        {
%            {
%                /val exch cvlit def
%                /key exch cvlit def
%                val type /dicttype eq
%                {
%                    val /ClassName known 
%                        {
%			  /ClassKeys 
%			      ClassKeys 999 key 256 string cvs arrayinsert def
%			  /ClassVals ClassVals 999 val arrayinsert def
%                        }
%                    if
%                } 
%                if
%                pause
%            } forall
%        } forall
%        ClassKeys
%        ClassVals
%    end
%
%    /ClassVals exch def
%    /ClassKeys exch def
%    ClassKeys ClassVals DoubleBubbleSort
%    ClassKeys ClassColor ClassPic ShowArray
%} def
%
%/DoMethods { % classdict => -
%    10 dict    begin
%        /classdict exch def
%        /MethodKeys [] def
%        /MethodVals [] def
%        classdict
%        {
%            /val exch def
%            /key exch def
%            /val load type /arraytype eq
%            /val load xcheck
%            and
%            {
%                /MethodKeys MethodKeys 999 key 256 string cvs arrayinsert def
%                /MethodVals MethodVals 999 /val load cvlit arrayinsert def
%            } 
%            if
%            pause
%        } forall
%        MethodKeys
%        MethodVals
%    end
%
%    userdict begin
%    /MethodVals exch def
%    /MethodKeys exch def
%    MethodKeys MethodVals DoubleBubbleSort
%
%    MethodKeys MethodColor MethodPic ShowArray
%    end
%
%} def
%
%/DoVars { % classdict => -
%    10 dict    begin
%        /classdict exch def
%        /VarKeys [] def
%        /VarVals [] def
%        classdict
%        {
%            /val exch def
%            /key exch def
%            /val load type /arraytype eq
%            /val load xcheck
%            and not
%            {
%                /VarKeys VarKeys 999 key 256 string cvs arrayinsert def
%                /VarVals VarVals 999 /val load cvlit arrayinsert def
%            } 
%            if
%            pause
%        } forall
%        VarKeys
%        VarVals
%    end
%
%    userdict begin
%    /VarVals exch def
%    /VarKeys exch def
%    VarKeys VarVals DoubleBubbleSort
%
%    VarKeys VarColor VarPic ShowArray
%    end
%
%} def
%
%/DoInsts { % classdict => -
%    %(DoInsts begin***\n) [] dbgprintf
%    10 dict    begin
%        /classdict exch def
%        /InstKeys [] def
%        /InstVals [] def
%        classdict /InstanceVarDict get
%        dup null eq { pop [] } if
%        {
%            /val exch def
%            /key exch def
%            /InstKeys InstKeys 999 key 256 string cvs arrayinsert def
%            /InstVals InstVals 999 /val load arrayinsert def
%            pause
%        } forall
%        InstKeys
%        InstVals
%    end
%
%    userdict begin
%    /InstVals exch def
%    /InstKeys exch def
%    InstKeys InstVals DoubleBubbleSort
%
%    InstKeys InstColor InstPic ShowArray
%    end
%
%    %(DoInsts end***\n) [] dbgprintf
%} def
%
%
%/LastClassPick		null def
%/LastInstPick 		null def
%/LastMethodPick		null def
%/LastVarPick 		null def
%
%/ClassPick    % x y => -
%{
%    userdict begin
%    Font15 setfont
%    LastClassPick null ne
%    { 
%        null SetMethodPick
%        null SetVarPick
%        null SetInstPick
%        gsave
%        %(unhilite %\n) [ LastClassPick ] dbgprintf
%        /getcanvas ClassPic send setcanvas
%        0 ClassPic /BufferHeight get 
%	    LastClassPick 1 add 18 mul sub 3 sub 300 18 rectpath
%            ClassColor setcolor fill
%        0 0 0 rgbcolor setcolor
%        5 ClassPic /BufferHeight get
%	    LastClassPick 1 add 18 mul sub moveto ClassKeys
%            LastClassPick get show
%        grestore
%    } if
%
%    10 dict begin
%    /y exch def
%    /x exch def
%
%    %% 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
%
%    /k ClassPic /BufferHeight get y sub 18 div floor def
%    %(pick is % \n ) [ k ] dbgprintf
%    k ClassKeys length 1 sub le
%    {
%        %(pick is % \n ) [ ClassKeys k get ] dbgprintf
%        /getcanvas ClassPic send setcanvas
%        %(hilite %\n) [ k ] dbgprintf
%        0 ClassPic /BufferHeight get k 1 add 18 mul sub 3 sub 300 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
%        [] MethodColor MethodPic ShowArray
%        [] VarColor VarPic ShowArray
%        [] InstColor InstPic ShowArray
%        [] TextColor TextPic ShowArray
%        [
%            (CLASS  ") ClassKeys k get 256 string cvs (") append append
%            ClassVals k get /ParentDictArray known
%            {
%                ClassVals k get /ParentDictArray get    % ParentDictArray
%                {
%                    /ClassName get 256 string cvs (    ) exch append
%                } forall
%            } if
%        ] TextColor TextPic ShowArray
%        ClassVals k get DoMethods
%        ClassVals k get DoVars
%        ClassVals k get DoInsts
%        k
%    }
%    {    
%        /updatecanvas ClassPic send
%        null
%    } ifelse
%    end
%    /LastClassPick exch def
%
%    end
%} def
%
%/SetInstPick {pop} def
%/SetInstPick %  newpick => -
%{
%    userdict begin
%    Font15 setfont
%    LastInstPick null ne
%    { 
%        gsave
%        /getcanvas InstPic send setcanvas
%        0 InstPic /BufferHeight get
%	    LastInstPick 1 add 18 mul sub 3 sub 300 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
%    /LastInstPick exch def    % 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 300 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
%    {
%        [] TextColor TextPic ShowArray
%        [
%            (INSTANCE  VARIABLE)
%            (    ") InstKeys LastInstPick get 256 string cvs (")
%                append append append
%            InstVals LastInstPick get type
%            {
%                /arraytype { () InstVals LastInstPick get ExpandArray }
%                /dicttype { () InstVals LastInstPick get ExpandDict }
%                /Default {() InstVals LastInstPick get 256 string cvs append}
%            }
%            case
%        ] TextColor TextPic ShowArray
%    } if
%    end
%} def
%/InstPick
%{
%    null SetMethodPick
%    null SetVarPick
%    userdict begin
%
%    10 dict begin
%    /y exch def
%    /x exch def
%    /k InstPic /BufferHeight get y sub 18 div floor def
%
%    %% put text scroll bar back to top
%    0 /setvalue TextPic        /VScrollbar get send
%
%    %% (pick is % \n ) [ k ] dbgprintf
%    k dup
%    end
%    InstKeys length 1 sub le
%        { SetInstPick }
%        { pop }
%    ifelse
%    end
%} def
%
%/ExpandArray {    % string array => strings			[ rhess ]
%    ArrayDepth 0 eq
%    { exch ({) append exch
%      /ArrayDepth ArrayDepth 1 add def
%      () ArrayDepth { (    ) append } repeat exch }
%    { exch () ArrayDepth { (    ) append } repeat 
%      2 copy eq
%      { pop ({  ) append exch }
%      { ({  ) append 3 -1 roll }
%      ifelse
%      /ArrayDepth ArrayDepth 1 add def }
%    ifelse
%    {
%        dup type /arraytype eq
%        {
%            ExpandArray
%        }
%        {
%            cvlit 256 string cvs append (  ) append
%            dup stringwidth pop 700 gt {
%                () ArrayDepth { (    ) append } repeat
%            } if
%        } ifelse
%    } forall
%    /ArrayDepth ArrayDepth 1 sub def
%    ArrayDepth 0 eq
%    { (}) }
%    { (}) append
%      () ArrayDepth { (    ) append } repeat }
%    ifelse
%} def
%
%/ExpandDict {    % dict => strings
%    {
%        256 string cvs (    ) exch append exch
%        256 string cvs (    ) exch append
%        { dup stringwidth pop 250 lt { ( ) append } { exit } ifelse } loop
%        exch append
%    } forall
%} def
%
%/SetMethodPick %  newpick => -
%{
%    userdict begin
%    Font15 setfont
%    LastMethodPick null ne
%    { 
%        gsave
%        /getcanvas MethodPic send setcanvas
%        0 MethodPic /BufferHeight get 
%	    LastMethodPick 1 add 18 mul sub 3 sub 300 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
%    /LastMethodPick exch def    % 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 300 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
%            () MethodVals LastMethodPick get ExpandArray
%        ] TextColor TextPic ShowArray
%    } if
%    end
%} def
%/MethodPick
%{
%    null SetVarPick
%    null SetInstPick
%    userdict begin
%
%    10 dict begin
%    /y exch def
%    /x exch def
%    /k MethodPic /BufferHeight get y sub 18 div floor def
%
%    %% put text scroll bar back to top
%    0 /setvalue TextPic        /VScrollbar get send
%
%    %% (pick is % \n ) [ k ] dbgprintf
%    k dup
%    end
%    MethodKeys length 1 sub le
%        { SetMethodPick }
%        { pop }
%    ifelse
%    end
%} def
%
%/SetVarPick %  newpick => -
%{
%    userdict begin
%    Font15 setfont
%    LastVarPick null ne
%    { 
%        gsave
%        /getcanvas VarPic send setcanvas
%        0 VarPic /BufferHeight get
%	    LastVarPick 1 add 18 mul sub 3 sub 300 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
%    /LastVarPick exch def    % 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 300 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
%    {
%        [] TextColor TextPic ShowArray
%        [
%            (CLASS  VARIABLE)
%            (    ") VarKeys LastVarPick get 256 string cvs (")
%                append append append
%            VarVals LastVarPick get type
%            %dup (type was %\n) [ 3 2 roll ] dbgprintf
%            {
%                /arraytype { () VarVals LastVarPick get ExpandArray }
%                /dicttype { () VarVals LastVarPick get ExpandDict }
%                /Default { () VarVals LastVarPick get 256 string cvs append }
%            }
%            case
%        ] TextColor TextPic ShowArray
%    } if
%    end
%} def
%/VarPick
%{
%    null SetMethodPick
%    null SetInstPick
%
%    userdict begin
%    10 dict begin
%    /y exch def
%    /x exch def
%    /k VarPic /BufferHeight get y sub 18 div floor def
%
%    %% put text scroll bar back to top
%    0 /setvalue TextPic        /VScrollbar get send
%
%    %% (pick is % \n ) [ k ] dbgprintf
%    k dup
%    end
%
%    VarKeys length 1 sub le
%        { SetVarPick }
%        { pop }
%    ifelse
%    end
%} def
%
%BrowserPopup killprocess				% 	[ rhess ]
%
%CreateBrowser						%	[ rhess ]
%
%end
%
%% ------------------------------------------------------------------------<eof>
SHAR_EOF
fi # end of overwriting check
#	End of shell archive
exit 0
-------------------------------------------------------------------------------
WHO:	Richard Hess			BELL:	[415] 940-1400 [ext.342]
TITLE:	Project Manager			CORP:	Consilium
      [ User Interface Services ]	SNAIL:	1945 Charleston Road
UUCP:	...!uunet!cimshop!rhess			Mountain View, CA 94043
-------------------------------------------------------------------------------