"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

'From Smalltalk/X, Version:2.10.4 on 24-feb-1995 at 7:10:38 am'!

StandardSystemView subclass:#BrowserView

	 instanceVariableNames:'classCategoryListView classListView methodCategoryListView

		methodListView classMethodListView codeView classToggle

		instanceToggle currentClassCategory currentClassHierarchy

		currentClass currentMethodCategory currentMethod currentSelector

		showInstance actualClass fullClass lastMethodCategory aspect

		variableListView fullProtocol lockUpdates autoSearch myLabel

		acceptClass'

	 classVariableNames:'CheckForInstancesWhenRemovingClasses DefaultIcon'

	 poolDictionaries:''

	 category:'Interface-Browsers'

!

BrowserView comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	     All Rights Reserved

'!

!BrowserView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

"

"

!

documentation

"

    this class implements all kinds of class browsers.

    Typically, it is started with 'SystemBrowser open', but there are many other 

    startup messages, to launch special browsers.

    See the categories 'startup' and 'special search startup' in the classes

    protocol.

    Alse, see the extra document 'doc/misc/sbrowser.doc' or the HTML online doc

    for how to use the browser.

    written winter 89 by claus

    Notice: SystemBrowser is currently being rewritten to be an instance

    of ApplicationModel - this transition is not yet complete and you see

    here intermediate versions of BrowserView/SystemBrowser. 

    All action is (currently) still done here in BrowserView, although the

    SystemBrowsers class methods are used to startup a browser.

    This will certainly change ...

"

! !

!BrowserView class methodsFor:'defaults'!

defaultIcon

    DefaultIcon isNil ifTrue:[

	DefaultIcon := Form fromFile:'SBrowser.xbm' resolution:100

    ].

    ^ DefaultIcon

! !

!BrowserView class methodsFor:'initialization'!

initialize

    "Browser configuration;

     (values can be changed from your private startup file)"

    "

     setting this to false, the removeClass function will remove

     classes WITHOUT checking for instances. Otherwise,

     it will check and let you confirm in case there are instances.

     Checking for instances may be a bit time consuming, though.

     The default is true - therefore, it will check

    "

    CheckForInstancesWhenRemovingClasses := true

    "

     CheckForInstancesWhenRemovingClasses := true

     CheckForInstancesWhenRemovingClasses := false

    "

! !

!BrowserView methodsFor:'misc'!

processName

    "the name of my process - for the processMonitor only"

    ^ 'System Browser'.

!

updateCodeView

    |code|

    fullClass ifTrue:[

	currentClass notNil ifTrue:[

	    code := currentClass source.

	]

    ] ifFalse:[

	currentMethod notNil ifTrue:[

	    (codeView acceptAction isNil

	    and:[actualClass notNil 

	    and:[currentMethodCategory notNil]]) ifTrue:[

		self setAcceptAndExplainActionsForMethod.

	    ].

	    code := currentMethod source.

	]

    ].

    codeView contents:code.

    codeView modified:false.

    self normalLabel.

!

instanceProtocol:aBoolean

    "switch between instance and class protocol"

    |onToggle offToggle|

    showInstance ~~ aBoolean ifTrue:[

	self checkSelectionChangeAllowed ifTrue:[

	    instanceToggle notNil ifTrue:[

		aBoolean ifTrue:[

		    offToggle := classToggle.

		    onToggle := instanceToggle.

		] ifFalse:[

		    onToggle := classToggle.

		    offToggle := instanceToggle.

		].

		onToggle turnOn.

		offToggle turnOff.

	    ].

	    showInstance := aBoolean.

	    (variableListView notNil

	    and:[variableListView hasSelection]) ifTrue:[

		self unhilightMethodCategories.

		self unhilightMethods.

		variableListView deselect

	    ].

	    fullProtocol ifTrue:[

		showInstance ifTrue:[

		    actualClass := currentClassHierarchy.

		] ifFalse:[

		    actualClass := currentClassHierarchy class.

		].

		acceptClass := actualClass.

		self updateClassList.

		self updateMethodCategoryListWithScroll:false.

		self updateMethodListWithScroll:false.

		self updateVariableList.

		^ self

	    ].

	    currentClass notNil ifTrue:[

		self classSelectionChanged

	    ].

	    codeView modified:false.

	] ifFalse:[

	    aBoolean ifTrue:[

		onToggle := classToggle.

		offToggle := instanceToggle

	    ] ifFalse:[

		offToggle := classToggle.

		onToggle := instanceToggle.

	    ].

	    onToggle turnOn.

	    offToggle turnOff.

	]

    ]

! !

!BrowserView methodsFor:'method stuff'!

methodSelectionChanged

    "method selection has changed - update dependent views"

    self withWaitCursorDo:[

	|index cls|

	self updateCodeView.

	self setAcceptAndExplainActionsForMethod.

	"

	 if there is any autoSearch string, do the search

	"

	autoSearch notNil ifTrue:[

	    codeView searchFwd:autoSearch startingAtLine:1 col:0 ifAbsent:[]

	].

	fullProtocol ifTrue:[

	    "

	     remove any bold attribute from classList

	    "

	    1 to:classListView list size do:[:i |

		classListView attributeAt:i remove:#bold.

	    ].

	    "

	     boldify the class where this method is implemented

	    "

	    currentMethod notNil ifTrue:[

		cls := currentMethod who at:1.

		index := classListView list indexOf:(cls name).

		(index == 0 

		 and:[cls isMeta

		 and:[cls name endsWith:'class']]) ifTrue:[

		    index := classListView list indexOf:(cls name copyWithoutLast:5).

		].

		index ~~ 0 ifTrue:[

		    classListView attributeAt:index add:#bold.

		].

		currentClass := acceptClass := cls.

	    ]

	].

    ]

!

updateMethodListWithScroll:scroll

    self updateMethodListWithScroll:scroll keepSelection:false

!

updateMethodListWithScroll:scroll keepSelection:keep

    |selectors scr first last selection|

    methodListView notNil ifTrue:[

	selection := methodListView selection.

	currentMethodCategory notNil ifTrue:[

	    fullProtocol ifTrue:[

		selectors := self listOfAllSelectorsInCategory:currentMethodCategory 

					    inFullProtocolHierarchyOfClass:actualClass

	    ] ifFalse:[

		selectors := self listOfAllSelectorsInCategory:currentMethodCategory

						       ofClass:actualClass

	    ]

	].

	scr := scroll.

	first := methodListView firstLineShown.

	first ~~ 1 ifTrue:[

	    last := methodListView lastLineShown.

	    selectors size <= (last - first + 1) ifTrue:[

		scr := true

	    ]

	].

	methodListView list = selectors ifFalse:[

	    scr ifTrue:[

		methodListView contents:selectors

	    ] ifFalse:[

		methodListView setContents:selectors

	    ]

	].

	keep ifTrue:[

	    methodListView selection:selection.

	]

    ]

!

listOfAllSelectorsInCategory:aCategory ofClass:aClass

    "answer a list of all selectors in a given method category 

     of the argument, aClass"

    |newList searchCategory all p|

    all := (aCategory = '* all *').

    (aCategory = '* no category *') ifTrue:[

	searchCategory := nil

    ] ifFalse:[

	searchCategory := aCategory

    ].

    newList := OrderedCollection new.

    aClass methodArray with:aClass selectorArray do:[:aMethod :selector |

	(all or:[aMethod category = searchCategory]) ifTrue:[

	    sel := selector.

	    (p := aMethod privacy) ~~ #public ifTrue:[

	    ].

	    aMethod isWrapped ifTrue:[

	    ].

	    aMethod isInvalid ifTrue:[

	    ].

	    newList add:sel

	]

    ].

    (newList size == 0) ifTrue:[^ nil].

    ^ newList sort

!

methodSelection:lineNr

    "user clicked on a method line - show code"

    |selectorString selectorSymbol|

    (fullProtocol not and:[currentClass isNil]) ifTrue:[^ self].

    selectorString := methodListView selectionValue.

    "

     kludge: extract real selector

    "

    selectorString := selectorString withoutSpaces upTo:(Character space).

    selectorSymbol := selectorString asSymbol.

    fullProtocol ifTrue:[

	currentMethod := currentSelector := nil.

	"

	 search which class implements the selector

	"

	self classesInFullProtocolHierarchy:actualClass do:[:c |

	    (currentMethod isNil 

	     and:[c implements:selectorSymbol]) ifTrue:[

		currentSelector := selectorSymbol.

		currentMethod := c compiledMethodAt:selectorSymbol.

		acceptClass := c

	    ]

	]

    ] ifFalse:[

	currentSelector := selectorSymbol.

	currentMethod := actualClass compiledMethodAt:selectorSymbol.

    ].

    methodCategoryListView notNil ifTrue:[

	currentMethod notNil ifTrue:[

	    (currentMethodCategory = currentMethod category) ifFalse:[

		currentMethodCategory := currentMethod category.

		methodCategoryListView selectElement:currentMethodCategory

	    ]

	]

    ].

    self methodSelectionChanged

!

updateMethodList

    self updateMethodListWithScroll:true keepSelection:false

!

checkMethodSelected

    currentMethod isNil ifTrue:[

	self warn:'select a method first'.

	^ false

    ].

    ^ true

!

template

    "return a method definition template"

    ^ 

'message selector and argument names

    "comment stating purpose of message"

    |temporaries|

    statements

"

 change above template into real code.

 Then ''accept'' either via the menu 

 or via the keyboard (usually CMD-A).

 You do not need this template; you can also

 select any existing methods code, change it,

 and finally ''accept''.

"

'

!

switchToMethodNamed:matchString

    |aSelector method cat index classToSearch selectors|

    currentClass notNil ifTrue:[

	showInstance ifTrue:[

	    classToSearch := currentClass

	] ifFalse:[

	    classToSearch := currentClass class

	].

	selectors := classToSearch selectorArray.

	((matchString ~= '*') and:[matchString includesMatchCharacters]) ifTrue:[

	    index := selectors findFirst:[:element | matchString match:element]

	] ifFalse:[

	    index := selectors indexOf:matchString

	].

	(index ~~ 0) ifTrue:[

	    aSelector := selectors at:index.

	    method := classToSearch methodArray at:index.

	    cat := method category.

	    cat isNil ifTrue:[cat := '* all *'].

	    methodCategoryListView selectElement:cat.

	    currentMethodCategory := cat.

	    self methodCategorySelectionChanged.

	    currentMethod := classToSearch compiledMethodAt:aSelector.

	    currentMethod notNil ifTrue:[

		currentSelector := aSelector.

		methodListView selectElement:aSelector.

	    ].

	    self methodSelectionChanged

	]

    ]

!

listOfAllSelectorsInCategory:aCategory inFullProtocolHierarchyOfClass:aClass

    "answer a list of all selectors in a given method category 

     of the argument, aClass and its superclasses.

     Used with fullProtocol browsing."

    |newList|

    newList := Set new.

    self classesInFullProtocolHierarchy:aClass do:[:c |

	|searchCategory|

	(aCategory = '* all *') ifTrue:[

	    newList addAll:(c selectorArray)

	] ifFalse:[

	    (aCategory = '* no category *') ifTrue:[

		searchCategory := nil

	    ] ifFalse:[

		searchCategory := aCategory

	    ].

	    c methodArray with:c selectorArray do:[:aMethod :selector |

		(aMethod category = searchCategory) ifTrue:[

		    newList add:selector

		]

	    ]

	].

    ].

    (newList size == 0) ifTrue:[^ nil].

    ^ newList asOrderedCollection sort

!

switchToAnyMethodNamed:aString

    |aSelector classToStartSearch aClass nm|

    aSelector := aString asSymbol.

    currentClass isNil ifTrue:[

	currentClassHierarchy notNil ifTrue:[

	    classToStartSearch := currentClassHierarchy

	]

    ] ifFalse:[

	classToStartSearch := currentClass 

    ].

    classToStartSearch notNil ifTrue:[

	showInstance ifFalse:[

	    classToStartSearch := classToStartSearch class

	].

	aClass := classToStartSearch whichClassIncludesSelector:aSelector.

	aClass notNil ifTrue:[

	    nm := aClass name.

	    showInstance ifFalse:[

		((nm ~= 'Metaclass') and:[nm endsWith:'class']) ifTrue:[

		    nm := nm copyWithoutLast:5 "copyTo:(nm size - 5)"

		]

	    ].

	    self switchToClassNamed:nm.

	    self switchToMethodNamed:aString

	]

    ]

! !

!BrowserView methodsFor:'private'!

checkSelectionChangeAllowed

    "return true, if selection change is ok;

     its not ok, if code has been changed.

     in this case, return the result of a user query"

    |action|

    codeView modified ifFalse:[

	^ true

    ].

    action := OptionBox 

		  request:(resources at:'text has not been accepted.\\Your modifications will be lost when continuing.') withCRs