"

 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.

"

ApplicationModel subclass:#SystemBrowser

	instanceVariableNames:'currentClass currentMethodCategory currentMethod currentSelector

		showInstance actualClasslastMethodCategory aspect lockUpdates

		autoSearch myLabel acceptClass'

	classVariableNames:'CheckForInstancesWhenRemovingClasses'

	poolDictionaries:''

	category:'Interface-Browsers'

!

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

"

!

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

    [author:]

        Claus Gittinger

"

! !

!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:'instance creation'!

open

    "launch a standard browser"

    ^ self openOnDevice:(Screen current) 

    "

     SystemBrowser open

    "

!

openInClass:aClass

    "launch a standard browser which immediately switches

     to aClass"

    ^ self openInClass:aClass selector:nil

    "

     SystemBrowser openInClass:Object

    "

    "Created: 30.4.1996 / 14:43:45 / cg"

!

openInClass:aClass selector:aSelector

    "launch a standard browser which immediately switches

     to aClass>>aSelector."

    |brwsr cls|

    brwsr := self openOnDevice:(Screen current).

    brwsr waitUntilVisible.

    cls := aClass.

    cls notNil ifTrue:[

	cls isMeta ifTrue:[

	    cls := aClass soleInstance

	].

	brwsr switchToClassNamed:cls name. 

	brwsr updateClassCategoryList.

	aClass isMeta ifTrue:[

	    brwsr instanceProtocol:false

	].

	brwsr updateMethodCategoryList.

	aSelector notNil ifTrue:[

	    brwsr switchToMethodNamed:aSelector.

	]

    ].

    ^ brwsr

    "

     SystemBrowser openInClass:Object selector:#at:put:

     SystemBrowser openInClass:Object selector:nil

     SystemBrowser openInClass:nil selector:nil

    "

    "Created: 22.11.1995 / 21:04:50 / cg"

!

openOnDevice:aDisplay

    "launch a standard browser on another display."

    ^ 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

    "

! !

!SystemBrowser class methodsFor:'private helpers'!

showNoneFound

    super warn:(self classResources string:'None found').

!

showNoneFound:what

    super warn:(self classResources string:(what , '...\\... none found') withCRs).

! !

!SystemBrowser class methodsFor:'private instance creation'!

newWithLabel:aString setupBlock:aBlock

    "common helper method for all creation methods"

    ^ self newWithLabel:aString setupBlock:aBlock onDevice:Screen current

!

newWithLabel:aString setupBlock:aBlock onDevice:aWorkstation

    "common helper method for all creation methods"

    |newBrowser|

    newBrowser := BrowserView onDevice:aWorkstation.

    newBrowser title:aString.

    aBlock value:newBrowser.

    newBrowser open.

    ^ newBrowser

!

newWithLabel:aString setupSelector:aSymbol arg:arg

    "common helper method for all creation methods"

    ^ self newWithLabel:aString setupSelector:aSymbol arg:arg onDevice:Screen current 

!

newWithLabel:aString setupSelector:aSymbol arg:arg onDevice:aWorkstation

    "common helper method for all creation methods"

    |newBrowser|

    newBrowser := BrowserView onDevice:aWorkstation.

    newBrowser title:aString.

    newBrowser perform:aSymbol with:arg.

    newBrowser open.

    ^ newBrowser

! !

!SystemBrowser class methodsFor:'special search startup'!

allCallsOn:aSelectorString

    "return a collection of methods which send aSelector."

    ^ self allCallsOn:#at:put: in:(Smalltalk allClasses)

    "

     SystemBrowser allCallsOn:#at:put:

    "

    "Created: 24.1.1997 / 19:42:57 / cg"

!

allCallsOn:aSelectorString in:aCollectionOfClasses

    "return a collection of methods which send aSelector.

     Methods from classes in aCollectionOfClasses are searched only."

    |sel searchBlock|

    ((aSelectorString ~= '*') 

     and:[aSelectorString includesMatchCharacters]) ifTrue:[

        "/ a matchString - need string matching procedure

        searchBlock := [:class :method :s |

                            method isLazyMethod ifTrue:[

                                (method source includesMatchString:aSelectorString) ifTrue:[

                                    method makeRealMethod.

                                    (method literalsDetect:[:aLiteral|

                                        (aLiteral isMemberOf:Symbol) 

                                          and:[aSelectorString match:aLiteral]

                                    ] ifNone:nil) notNil

                                ] ifFalse:[

                                    false

                                ]

                            ] ifFalse:[

                                (method literalsDetect:[:aLiteral|

                                    (aLiteral isMemberOf:Symbol) 

                                      and:[aSelectorString match:aLiteral]

                                ] ifNone:nil) notNil

                            ]

                       ].

    ] ifFalse:[

        (aSelectorString = '*') ifTrue:[

            searchBlock := [:class :method :s | true].

        ] ifFalse:[

            "/ no matchString - can do it much faster

            sel := aSelectorString asSymbolIfInterned.

            sel isNil ifTrue:[

                ^ nil     "/ none

            ].

            searchBlock := [:class :method :s | 

                                method isLazyMethod ifTrue:[

                                    (method source includesString:sel) ifTrue:[

                                        method makeRealMethod.

                                        method sends:sel.

                                    ] ifFalse:[

                                        false

                                    ]

                                ] ifFalse:[

                                    method sends:sel

                                ]

                           ].

        ]

    ].

    ^ self allMethodsIn:aCollectionOfClasses where:searchBlock

    "

     SystemBrowser allCallsOn:#at:put: in:(Smalltalk allClasses)

    "

    "Modified: 18.4.1997 / 10:32:50 / cg"

!

allMethodsIn:aCollectionOfClasses inst:wantInst class:wantClass where:aBlock

    "return a collection of methods which pass the given test.

     wantInst/wantClass control if instMethods and/or classMethods are to be

     considered.

     Only classes in aCollectionOfClasses are inspected in the search"

    |list|

    "

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

    "

    Processor activeProcess withLowerPriorityDo:[

        |checkedClasses checkBlock|

        checkedClasses := IdentitySet new.

        list := OrderedCollection new.

        checkBlock := [:cls |

            (checkedClasses includes:cls) ifFalse:[

                cls isObsolete ifTrue:[

                    Transcript showCR:'skipping obsolete class: ' , cls displayString

                ] ifFalse:[

                    cls methodDictionary keysAndValuesDo:[:sel :method |

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

                            list add:method "/ (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

        ]

    ].

    ^ list

    "Created: 24.1.1997 / 19:41:12 / cg"

!

allMethodsIn:aCollectionOfClasses where:aBlock

    "return a collection of methods which pass the given test.

     Only classes in aCollectionOfClasses are inspected in the search"

    ^ self

        allMethodsIn:aCollectionOfClasses 

        inst:true 

        class:true

        where:aBlock

    "Created: 24.1.1997 / 19:41:49 / cg"

!

aproposSearch:aString

    "browse all methods, which have aString in their selector or

     in the methods comment.

     This is relatively slow, since all source must be processed."

    ^ self aproposSearch:aString in:(Smalltalk allClasses)

!

aproposSearch:aString in:aCollectionOfClasses

    "browse all methods, which have aString in their selector or

     in the methods comment.

     This is relatively slow, since all source must be processed."

    |matchString list s searchBlock browser|

    matchString := '*' , aString , '*'.

    list := OrderedCollection new.

    (aString includesMatchCharacters) ifTrue:[

        s := '*' , aString , '*'.

        "a matchString"

        searchBlock := [:text | (text asCollectionOfLinesfindFirst:[:line | s match:line]) ~~ 0].

    ] ifFalse:[

        searchBlock := [:source | (source findString:aString) ~~ 0]

    ].

    browser := self browseMethodsIn:aCollectionOfClasses 

                     where:[:class :method :sel |

                                |comment|

                                Processor yield.

                                (searchBlock value:sel) ifTrue:[

                                    true

                                ] ifFalse:[

                                    comment := method comment.

                                    comment notNil 

                                    and:[searchBlock value:method comment]

                                ].

                           ]

                     title:(ClassResources string:'apropos: %1' with:aString).

    browser notNil ifTrue:[

        browser autoSearch:aString 

    ].

    ^ browser

    "

     SystemBrowser aproposSearch:'append' in:(Collection withAllSubclasses)

     SystemBrowser aproposSearch:'add'    in:(Collection withAllSubclasses)