"======================================================================
|
|   Smalltalk GUI method set browser
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Brad Diller.  Namespace support by Paolo Bonzini.
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk is free software; you can redistribute it and/or modify it
| under the terms of the GNU General Public License as published by the Free
| Software Foundation; either version 2, or (at your option) any later version.
| 
| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
| details.
| 
| You should have received a copy of the GNU General Public License along with
| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================
"

GuiData subclass:  #MethodSetBrowser
	instanceVariableNames: 'methodList theClass theSelector selection '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Browser'
!

!MethodSetBrowser class methodsFor: 'instance creation'!


implementorsOf: aSymbol parent: listView
"Opens a message set browser on all methods that implement selected method"
     | col |
     col := SortedCollection new.
"Collect all methods which implement selected method.  Collection is sorted 
alphabetically"
     Namespace current allClassObjectsDo: [:subclass |
	 (subclass includesSelector: aSymbol) ifTrue: [
	    col add: (subclass >> aSymbol) printString ]].
     MethodSetBrowser new openOn: col title: 'Implementors of ', aSymbol
	  selection: nil.
!

sendersOf: aSymbol parent: listView
     | alert sender specialSelector |
     sender := SortedCollection new.

     Namespace current allClassObjectsDo: 
     [:subclass | (subclass whichSelectorsReferTo: aSymbol) do: 
	  [ :sel | sender add: (subclass >> sel) printString ]].

     sender isEmpty ifTrue: [^alert := ModalDialog new alertMessage: 'No senders for ', 
	  aSymbol in: listView]. 
     ^self new openOn: sender title: 'Senders of ', aSymbol
	  selection: aSymbol.
! !

!MethodSetBrowser methodsFor: 'initializing'!

openOn: aMethodDictionary title: name  selection: aSymbol
"Open a method set browser.  The argument aMethodDictionary consists of 
alpha-sorted collection of strings.  Each element is of two forms: 1) className 
class selector, or 2) className selector.  This browser consists of two 
vertically placed panes.  The top pane is a list which displays the sorted 
methods in aMethodDictionary.  The bottom pane is a text view which will 
display the source code for a selector which is selected from the top pane.  
	In general, aSymbol denotes a selector.  If this parameter is non-nil, the 
first occurence of aSymbol will be selected in the text view when a 
selector is first selected from the top pane" 
    | topView childView aStream listView textView container | 
    aSymbol notNil 
	"Parse selector expression, aSymbol, inclusive of first colon"
	ifTrue:[aStream := WriteStream on: (String new: 0). 
		aSymbol detect: [ :ch | aStream nextPut: ch. ch == $:]
			ifNone: [0].
		selection := aStream contents].

    topView := BrowserShell new: name, ' (', aMethodDictionary size printString, ')'.
    topView data: self.
    topView blox x: 0.
    topView blox y: 330.
    topView blox height: 308.
    topView blox width: 408.

    "Use Form class to manage the list and text view panes"
    childView := Form new: 'Form' in: topView.
    topView addChildView: childView.
    container := childView blox.      

    "Create a list in top half of window"
    childView addChildView: ((listView := PList new: 'MethodSet' in: childView)
				 initialize;
				 data: self;
				 stateChange: #methodList; 
				 handleUserChange: #methodSelection:; 
				 listMsg: #methodList;
				 yourself).
    listView blox xPixels: 4; yPixels: 4; width: 400 height: 150.

    "Create a text view and install in lower half of window"
    childView addChildView: ((textView := PCode new: childView)
				 data: self;
				 stateChange: #text;
				 handleUserChange: #compile:from:;
				 textMsg: #text;
				 selection: selection;
				 yourself).
    textView menuInit: ((PopupMenu new: textView label: '') selectors: 
		     #(('Cut' gstCut) ('Copy' gstCopy) ('Paste' gstPaste) 
		     () ('Clear' gstClear) () ('Line...' line)  ('Find...' find) ()
		     ('Do it' eval) ('Print it' evalAndPrintResult)
		     ('Inspect' evalAndInspectResult)
		     () ('Accept' compileIt) ('Cancel' revert) () ('Close' close))
							    receiver: textView
							    argument: nil).
    textView blox width: 400 height: 150.
    textView blox posVert: (listView blox).
    textView blox xOffset: 4; yOffset: 4.
    "Initialize instance variable, methodList, which governs list display"
	
     methodList := aMethodDictionary.
     self changeState: #methodList.
     Primitive updateViews.
    "Initialize all the manufactured widgets"
    topView display
! !

!MethodSetBrowser methodsFor: 'accessing'!

methodList
    ^methodList
!

methodSelection: assoc
"Derive class and selector from list selection.  The selection is derived
from an item in the method list pane.  A list item may be of two
forms: 1) className class selector, or 2) className selector. Form (1)
contains 3 string tokens and form (2) contains 2.  To derive the class
from form (1), the instance class is derived from the Smallltalk
dictionary using the first string token as a key.  Then class is sent
to the instance class to derive the class of the instance class.  The
selector is derived from the third token.  In form (2), the instance
class is derived directly from the first string token.  The selector
is obtained from the second token"
    | parsing className |
    assoc value isNil ifTrue: [^theSelector := nil].
    parsing := ReadStream on: assoc value.
    className := parsing upToAll: '>>#'.
    theSelector := parsing upToEnd asSymbol.
    (className includes: Character space)
	ifTrue: [
	    parsing position: 1.
	    className := parsing upTo: Character space.
	    theClass := (Smalltalk at: className asSymbol) class
	]
	ifFalse: [ theClass := Smalltalk at: className asSymbol].

    self changeState: #text.
    Primitive updateViews.
!

text
"Return source code for the selected method"
    theSelector notNil 
	ifTrue: [^theClass -> (theClass sourceCodeAt: theSelector) ].
    ^''.
! !


!MethodSetBrowser methodsFor: 'text view blue button menu'!

compile: aString from: aView
"Compile aString derived from text in text view for the selected selector"
    theSelector isNil ifTrue: [^aView beep].
	  theClass compile: aString classified: 
	      ((theClass compiledMethodAt: theSelector) methodCategory) 
			   ifError: [:fname :lineNo :errorString |
				  aView displayError: errorString at: lineNo.
  				  ^nil ].
!

selection
    ^selection
! !