"

 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 5:09:20 am'!

ApplicationModel subclass:#SystemBrowser

	 instanceVariableNames:'currentClass currentMethodCategory currentMethod currentSelector

		showInstance actualClasslastMethodCategory aspect lockUpdates

		autoSearch myLabel acceptClass'

	 classVariableNames:'CheckForInstancesWhenRemovingClasses'

	 poolDictionaries:''

	 category:'Interface-Browsers'

!

!SystemBrowser class methodsFor:'initialization'!

initialize

    "Browser configuration;

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

    self classResources.

    "

     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

     SystemBrowser initialize

    "

! !

!SystemBrowser 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 an intermediate version. The instance variables defined here are NOT

    currently used - instead, everything is really done in the BrowserView

    which (currently) keeps the real state of the browser.

    This will certainly change ...

"

! !

!SystemBrowser class methodsFor:'instance creation'!

openOnDevice:aDisplay

    "launch a standard browser on another display.

     Does not work currently - still being developped."

    ^ self newWithLabel:(self classResources string:'System Browser')

	     setupBlock:[:browser | browser setupForAll]

	      onDevice:aDisplay

    "|d|

     d := XWorkstation new initializeFor:'porty:0'.

     d startDispatch.

     SystemBrowser openOnDevice:d

    "

!

open

    "launch a standard browser"

    ^ self openOnDevice:(Screen current) 

    "

     SystemBrowser open

    "

! !

!SystemBrowser class methodsFor:'startup'!

browseMethods:aList title:aString

    "launch a browser for an explicit list of class/selectors.

     Each entry in the list must consist of the classes name and the selector,

     separated by spaces. For class methods, the string 'class' must be

     appended to the classname."

    (aList size == 0) ifTrue:[

	self showNoneFound:aString.

	^ nil

    ].

    aList sort.

    ^ self 

	newWithLabel:aString

	setupSelector:#setupForList:

	arg:aList

    "

     SystemBrowser 

	browseMethods:#('Object printOn:' 'Collection add:')

	title:'some methods'

    "

    "

     SystemBrowser 

	browseMethods:#('Behavior new:' 'Setclass new:')

	title:'some new: methods'

    "

!

browseMethodsIn:aCollectionOfClasses inst:wantInst class:wantClass where:aBlock title:title

    "launch a browser for all instance- (if wantInst is true) and/or

     classmethods (if wantClass is true) from classes in aCollectionOfClasses,

     where aBlock evaluates to true.

     The block is called with 3 arguments, class, method and seelctor."

    |list|

    "

     since this may take a long time, lower my priority ...

    "

    Processor activeProcess withLowerPriorityDo:[

	|checkedClasses checkBlock|

	checkedClasses := IdentitySet new.

	list := OrderedCollection new.

	checkBlock := [:cls |

	    |methodArray selectorArray| 

	    (checkedClasses includes:cls) ifFalse:[

		methodArray := cls methodArray.

		selectorArray := cls selectorArray.

		1 to:methodArray size do:[:index |

		    |method sel|

		    method := methodArray at:index.

		    sel := selectorArray at:index.

		    (aBlock value:cls value:method value:sel) ifTrue:[

			list add:(cls name , ' ' , sel)

		    ]

		].

		checkedClasses add:cls.

	    ]

	].

	aCollectionOfClasses do:[:aClass |

	    "

	     output disabled - it slows down things too much (when searching for

	     implementors or senders)

	    "

	    wantInst ifTrue:[

"/                Transcript show:'searching '; show:aClass name; showCr:' ...'; endEntry.

		checkBlock value:aClass

	    ].

	    wantClass ifTrue:[

"/                Transcript show:'searching '; show:aClass class name; showCr:' ...'; endEntry.

		checkBlock value:(aClass class)

	    ].

	    Processor yield

	]

    ].

    ^ self browseMethods:list title:title

!

browseMethodsIn:aCollectionOfClasses where:aBlock title:title

    "launch a browser for all instance- and classmethods from 

     all classes in aCollectionOfClasses where aBlock evaluates to true.

     The block is called with 3 arguments, class, method and seelctor."

    ^ self browseMethodsIn:aCollectionOfClasses inst:true class:true where:aBlock title:title

!

browseClassCategory:aClassCategory

    "launch a browser for all classes under aCategory"

    ^ self 

	newWithLabel:aClassCategory

	setupSelector:#setupForClassCategory:

	arg:aClassCategory

    "SystemBrowser browseClassCategory:'Kernel-Objects'"

!

browseFullClasses

    "launch a browser showing all methods at once"

    ^ self 

	newWithLabel:'Full Class Browser'

	setupBlock:[:newBrowser | newBrowser setupForFullClass]

    "SystemBrowser browseFullClasses"

!

browseClass:aClass

    "launch a browser for aClass"

    ^ self 

	newWithLabel:aClass name

	setupSelector:#setupForClass:

	arg:aClass

    "SystemBrowser browseClass:Object"

!

browseClass:aClass selector:selector

    "launch a browser for the method at selector in aClass"

    ^ self 

	newWithLabel:(aClass name , ' ' , selector , ' ' , selector)

	setupBlock:[:newBrowser | newBrowser setupForClass:aClass selector:selector]

    "

     SystemBrowser browseClass:Object selector:#printString

    "

!

browseClassHierarchy:aClass

    "launch a browser for aClass and all its superclasses.

     this is different from the fullProtocol browser."

    ^ self 

	newWithLabel:(aClass name , '-' , 'hierarchy')

	setupSelector:#setupForClassHierarchy:

	arg:aClass

    "

     SystemBrowser browseClassHierarchy:Number

    "

!

browseFullClassProtocol:aClass

    "launch a browser for aClasses full protocol.

     This is different from hierarchy browsing."

    ^ self 

	newWithLabel:(aClass name , '-' , 'full protocol')

	setupSelector:#setupForFullClassProtocol:

	arg:aClass

    "

     SystemBrowser browseFullClassProtocol:Number

    "

!

browseClasses:aList title:title

    "launch a browser for all classes in aList"

    ^ self 

	newWithLabel:title

	setupSelector:#setupForClassList:

	arg:aList

    "

     SystemBrowser browseClasses:(Array with:Object

					with:Float)

			   title:'two classes'

    "

!

browseClass:aClass methodCategory:aCategory

    "launch a browser for all methods under aCategory in aClass"

    ^ self newWithLabel:(aClass name , ' ' , aCategory)

	  setupBlock:[:browser | browser setupForClass:aClass methodCategory:aCategory]

    "SystemBrowser browseClass:String methodCategory:'copying'"

!

browseMethodCategory:aCategory

    "launch a browser for all methods where category = aCategory"

    |searchBlock|

    aCategory includesMatchCharacters ifTrue:[

	searchBlock := [:c :m :s | aCategory match:m category].

    ] ifFalse:[

	searchBlock := [:c :m :s | m category = aCategory]

    ].

    self browseMethodsWhere:searchBlock title:('all methods with category of ' , aCategory)

    "

     SystemBrowser browseMethodCategory:'printing & storing'

     SystemBrowser browseMethodCategory:'print*'

    "

!

browseAllSelect:aBlock

    "launch a browser for all methods where aBlock returns true.

     The block is called with 3 arguments, class, method and seelctor."

    ^ self browseMethodsWhere:aBlock title:'selected messages'

    "

     SystemBrowser browseAllSelect:[:aClass :aMethod :selector | selector numArgs == 3]

    "

!

browseMethodsWhere:aBlock title:title

    "launch a browser for all methods where aBlock returns true.

     The block is called with 3 arguments, class, method and seelctor."

    ^ self browseMethodsIn:(Smalltalk allClasses) where:aBlock title:title

!

browseMethodsOf:aClass where:aBlock title:title

    "launch a browser for all instance- and classmethods in aClass 

     where aBlock evaluates to true.

     The block is called with 3 arguments, class, method and seelctor."

    ^ self browseMethodsIn:(Array with:aClass) where:aBlock title:title

!

browseMethodsFrom:aClass where:aBlock title:title

    "launch a browser for all instance- and classmethods in aClass

     and all its subclasses where aBlock evaluates to true.

     The block is called with 3 arguments, class, method and seelctor."

    ^ self browseMethodsIn:(aClass withAllSubclasses) where:aBlock title:title

!

browseInstMethodsOf:aClass where:aBlock title:title

    "launch a browser for all instance methods in aClass

     where aBlock evaluates to true"

    ^ self browseMethodsIn:(Array with:aClass) inst:true class:false where:aBlock title:title

!

browseInstMethodsIn:aCollectionOfClasses where:aBlock title:title

    "launch a browser for all instance methods of all classes in

     aCollectionOfClasses where aBlock evaluates to true"

    ^ self browseMethodsIn:aCollectionOfClasses inst:true class:false 

		     where:aBlock title:title

!

browseInstMethodsFrom:aClass where:aBlock title:title

    "launch a browser for all instance methods in aClass and all subclasses

     where aBlock evaluates to true"

    ^ self browseMethodsIn:(aClass withAllSubclasses) inst:true class:false where:aBlock title:title

! !

!SystemBrowser class methodsFor:'startup with query'!

getClassThenPerform:aSelector

    |enterBox|

    enterBox := EnterBox title:(self classResources at:'Browse which class:') withCRs.

    enterBox okText:(self classResources at:'browse').

    enterBox entryCompletionBlock:[:contents |

	|s what m|

	s := contents withoutSpaces.

	what := Smalltalk classnameCompletion:s.

	enterBox contents:what first.

    ].

    enterBox action:[:className |

	|cls|

	cls := Smalltalk classNamed:className.

	cls isNil ifTrue:[

	    self warn:(self classResources at:'no such class').

	] ifFalse:[

	    self perform:aSelector with:cls  

	]

    ].

    enterBox showAtPointer

    "

     SystemBrowser getClassThenPerform:#browseClass:

    "

!

askThenBrowseClass

    self getClassThenPerform:#browseClass:

    "

     SystemBrowser askThenBrowseClass

    "

!

askThenBrowseClassHierarchy

    self getClassThenPerform:#browseClassHierarchy:

    "

     SystemBrowser askThenBrowseClassHierarchy

    "

!

askThenBrowseFullClassProtocol

    self getClassThenPerform:#browseFullClassProtocol:

    "

     SystemBrowser askThenBrowseFullClassProtocol

    "

! !

!SystemBrowser class methodsFor:'special search startup'!

browseAllCallsOn:aSelectorString in:aCollectionOfClasses title:title

    "launch a browser for all senders of aSelector in aCollectionOfClasses"

    |sel browser searchBlock|

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

	"a matchString"

	searchBlock := [:class :method :s |

			    |lits found|

			    lits := method literals.

			    found := false.

			    lits notNil ifTrue:[

				lits do:[:aLiteral |

				    found ifFalse:[

					(aLiteral isMemberOf:Symbol) ifTrue:[

					    found := (aSelectorString match:aLiteral)

					]

				    ]

				]

			    ].

			    found

		       ].

    ] ifFalse:[

	sel := aSelectorString asSymbolIfInterned.

	sel isNil ifTrue:[

"

	    Transcript showCr:'none found.'.

"

	    self showNoneFound:title.

	    ^ nil

	].

	searchBlock := [:class :method :s | method sends:sel].

    ].

    browser := self browseMethodsIn:aCollectionOfClasses

			      where:searchBlock

			      title:title.

    browser notNil ifTrue:[

	|s|

	"

	 kludge for now, if its a multipart selector,

	 no easy search is (as yet) possible

	"

	s := aSelectorString.

	(s includes:$:) ifTrue:[

	    s := s copyTo:(s indexOf:$:)

	].

	browser autoSearch:s 

    ].

    ^ browser