"{ 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

                              enterBox questBox 

                              selectBox lastMethodCategory'

       classVariableNames:''

       poolDictionaries:''

       category:'Interface-Browsers'

!

SystemBrowser comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

             All Rights Reserved

$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.10 1994-08-13 18:39:07 claus Exp $

'!

!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

"

$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.10 1994-08-13 18:39:07 claus Exp $

"

!

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 prio checkedClasses checkBlock|

    "

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

    "

    prio := Processor activeProcess priority.

    Processor activeProcess priority:(prio - 1).

    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.

        ]

    ].

    [

        checkedClasses := IdentitySet new.

        list := OrderedCollection new.

        aCollectionOfClasses do:[:aClass |

            wantInst ifTrue:[checkBlock value:aClass].

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

        ]

    ] valueNowOrOnUnwindDo:[

        Processor activeProcess priority:prio.

    ].

    ^ 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

    ].

    ^ browser

!

browseForSymbol:aSymbol

    "launch a browser for all methods referencing aSymbol"

    ^ self browseForSymbol:aSymbol title:('users of ' , aSymbol) warnIfNone:true

!

browseReferendsOf:aGlobalName warnIfNone:doWarn

    "launch a browser for all methods referencing a global

     named aGlobalName.

    "

    ^ self browseForSymbol:aGlobalName title:('users of: ' , aGlobalName) warnIfNone:doWarn 

!