"{ Package: 'Programming Tools' }"

"

 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.

"

StandardSystemView subclass:#SystemBrowser

       instanceVariableNames:'classCategoryListView classListView

			      methodCategoryListView methodListView

			      classMethodListView

			      codeView classToggle instanceToggle

			      currentClassCategory currentClassHierarchy

			      currentClass

			      currentMethodCategory currentMethod

			      showInstance actualClass fullClass

       classVariableNames:''

       poolDictionaries:''

       category:'Interface-Browsers'

!

SystemBrowser comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	     All Rights Reserved

'!

!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.

    Stypically, it is started with SystemBrowser open, but there are many other startup

    messages, to launch special browsers.

    See the extra document 'doc/misc/sbrowser.doc' for how to use this browser.

    written winter 89 by claus

"

! !

!SystemBrowser class methodsFor:'general startup'!

open

    "launch a standard browser"

    ^ self openOnDisplay:Display

    "SystemBrowser open"

!

openOnDisplay: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]

		     on:aDisplay

    "

     SystemBrowser openOnDisplay:(XWorkstation new initializeFor:'porty:0')

    "

! !

!SystemBrowser class methodsFor:'startup'!

browseFullClasses

    "launch a browser showing all methods at once"

    ^ self newWithLabel:'Full Class Browser'

	     setupBlock:[:browser | browser setupForFullClass]

    "SystemBrowser browseFullClasses"

!

browseClassCategory:aClassCategory

    "launch a browser for all classes under aCategory"

    ^ self newWithLabel:aClassCategory

	     setupBlock:[:browser | browser setupForClassCategory:aClassCategory]

    "SystemBrowser browseClassCategory:'Kernel-Objects'"

!

browseClass:aClass

    "launch a browser for aClass"

    ^ self newWithLabel:aClass name

	     setupBlock:[:browser | browser setupForClass:aClass]

    "SystemBrowser browseClass:Object"

!

browseClassHierarchy:aClass

    "launch a browser for aClass and all its superclasses"

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

	     setupBlock:[:browser | browser setupForClassHierarchy:aClass]

    "SystemBrowser browseClassHierarchy:Number"

!

browseClasses:aList title:title

    "launch a browser for all classes in aList"

    ^ self newWithLabel:title

	     setupBlock:[:browser | browser setupForClassList: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'"

!

browseClass:aClass selector:selector

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

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

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

    "SystemBrowser browseClass:Object selector:#printString"

!

browseMethods:aList title:aString

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

    (aList size == 0) ifTrue:[

	self showNoneFound:aString.

	^ nil

    ].

    aList sort.

    ^ self newWithLabel:aString

	     setupBlock:[:browser | browser setupForList:aList]

    "

     SystemBrowser browseMethods:#('Object printOn:' 

				   'Collection add:')

			   title:'some methods'

    "

!

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'

!

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

!

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

!

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 |

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

	    wantInst ifTrue:[checkBlock value:aClass].

	    wantClass ifTrue:[checkBlock value:(aClass class)].

	    Processor yield

	]

    ].

    ^ self browseMethods:list 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

!

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

!

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

! !

!SystemBrowser class methodsFor:'special search startup'!

browseImplementorsOf:aSelectorString in:aCollectionOfClasses title:title

    "launch a browser for all implementors of aSelector in

     the classes contained in aCollectionOfClasses and its metaclasses"

    |list sel|

    list := OrderedCollection new.

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

	"a matchString"

	aCollectionOfClasses do:[:aClass |

	    aClass selectorArray do:[:aSelector |

		(aSelectorString match:aSelector) ifTrue:[

		    list add:(aClass name , ' ' , aSelector)

		]

	    ].

	    aClass class selectorArray do:[:aSelector |

		(aSelectorString match:aSelector) ifTrue:[

		    list add:(aClass name , 'class ' , aSelector)

		]

	    ]

	]

    ] ifFalse:[

	"can do a faster search"

	aSelectorString knownAsSymbol ifFalse:[

	    self showNoneFound:title.

	    ^ nil

	].

	sel := aSelectorString asSymbol.

	aCollectionOfClasses do:[:aClass |

	    (aClass implements:sel) ifTrue:[

		list add:(aClass name , ' ' , aSelectorString)

	    ].

	    (aClass class implements:sel) ifTrue:[

		list add:(aClass name , 'class ' , aSelectorString)

	    ]

	]

    ].

    ^ self browseMethods:list title:title

    "

     SystemBrowser browseImplementorsOf:#+

				     in:(Array with:Number

					       with:Float

					       with:SmallInteger)

				  title:'some implementors of +'

    "

!

browseImplementorsOf:aSelectorString

    "launch a browser for all implementors of aSelector"

    ^ self browseImplementorsOf:aSelectorString

			     in:(Smalltalk allClasses)

			  title:('implementors of: ' , aSelectorString)

    "

     SystemBrowser browseImplementorsOf:#+

    "

!

browseImplementorsOf:aSelectorString under:aClass

    "launch a browser for all implementors of aSelector in aClass

     and its subclasses"

    ^ self browseImplementorsOf:aSelectorString

			     in:(aClass withAllSubclasses)

			  title:('implementors of: ' , 

				 aSelectorString , 

				 ' (in or below ' , aClass name , ')')

    "

     SystemBrowser browseImplementorsOf:#+ under:Integer

    "

!

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 := [:lits |

			    |found|

			    found := false.

			    lits notNil ifTrue:[

				lits do:[:aLiteral |

				    found ifFalse:[

					(aLiteral isMemberOf:Symbol) ifTrue:[

					    found := (aSelectorString match:aLiteral)

					]

				    ]

				]

			    ].

			    found

		       ].

	browser := self browseMethodsIn:aCollectionOfClasses

				  where:[:class :method :s | searchBlock value:(method literals)]

				  title:title

    ] ifFalse:[

	aSelectorString knownAsSymbol ifFalse:[

"

	    Transcript showCr:'none found.'.

"

	    self showNoneFound:title.

	    ^ nil

	].

	sel := aSelectorString asSymbol.

	browser := self browseMethodsIn:aCollectionOfClasses

				  where:[:class :method :s | method sends:sel]

				  title:title

    ].

    browser notNil ifTrue:[

	browser setSearchPattern:aSelectorString

    ].

    ^ browser

!

browseAllCallsOn:aSelectorString

    "launch a browser for all senders of aSelector"

    ^ self browseAllCallsOn:aSelectorString 

			 in:(Smalltalk allClasses)

		      title:('senders of ' , aSelectorString)

    "

     SystemBrowser browseAllCallsOn:#+

    "

!

browseCallsOn:aSelectorString under:aClass

    "launch a browser for all senders of aSelector in aClass and subclasses"

    ^ self browseAllCallsOn:aSelectorString

			 in:(aClass withAllSubclasses)

		      title:('senders of: ' , 

			     aSelectorString , 

			     ' (in or below ' , aClass name , ')')

    "

     SystemBrowser browseAllCallsOn:#+ under:Number

    "

!

browseForSymbol:aSymbol title:title warnIfNone:doWarn

    "launch a browser for all methods referencing aSymbol"

    |browser searchBlock sym|

    (aSymbol includesMatchCharacters) ifTrue:[

	"a matchString"

	searchBlock := [:lits |

			    |found|

			    found := false.

			    lits notNil ifTrue:[

				lits do:[:aLiteral |

				    found ifFalse:[

					(aLiteral isMemberOf:Symbol) ifTrue:[

					    found := (aSymbol match:aLiteral)

					]

				    ]

				]

			    ].

			    found

		       ].

    ] ifFalse:[

	"

	 can do a faster search

	"

	aSymbol knownAsSymbol ifFalse:[

	    self showNoneFound:title.

	    ^ nil

	].

	sym := aSymbol asSymbol.

	searchBlock := [:lits |

			    |found|

			    found := false.

			    lits notNil ifTrue:[

				lits do:[:aLiteral |

				    found ifFalse:[

					(aLiteral isMemberOf:Symbol) ifTrue:[

					    found := (sym == aLiteral)

					]

				    ]

				]

			    ].

			    found

		       ].

    ].

    browser := self browseMethodsWhere:[:c :m :s | searchBlock value:(m literals)] title:title.

    browser notNil ifTrue:[

	browser setSearchPattern:aSymbol

    ].