"

 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.

"

"{ Package: 'stx:libtool' }"

ApplicationModel subclass:#SystemBrowser

	instanceVariableNames:''

	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 == SystemBrowser ifFalse:[

        ^ super open

    ].

    ^ 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

        ].

        aClass isMeta ifTrue:[

            brwsr instanceProtocol:false

        ].

        aClass isJavaClass ifTrue:[

            brwsr switchToClassNamed:aClass fullName. 

        ] ifFalse:[

            brwsr switchToClassNamed:aClass name. 

        ].

"/        brwsr updateClassCategoryList.

"/        brwsr updateMethodCategoryList.

"/        brwsr updateVariableList.

        brwsr classSelectionChanged.

        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"

    "Modified: / 14.10.1998 / 15:31:52 / cg"

!

openOnDevice:aDisplay

    "launch a standard browser on another display."

    self == SystemBrowser ifFalse:[

        ^ super openOnDevice:aDisplay

    ].

    ^ 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:'Compatibility - ST80'!

newOnClass:aClass

    ^ self browseClass:aClass

    "Created: / 27.10.1997 / 20:10:39 / cg"

! !

!SystemBrowser class methodsFor:'interface specs'!

metaSpec

        "UIPainter new openOnClass: self andSelector: #metaSpec"

        <resource: #canvas>

        ^#(#FullSpec 

                #window: 

                #(#WindowSpec 

                        #label: 'Unlabeled Canvas' 

                        #bounds: #(#Rectangle 27 249 325 334 ) ) 

                #component: 

                #(#SpecCollection 

                        #collection: #(

                                #(#RadioButtonSpec 

                                        #layout: #(#LayoutFrame 0 0 4 0 -1 0.575 20 0 ) 

                                        #name: #instanceSwitch 

                                        #model: #metaHolder 

                                        #callbacksSpec: 

                                        #(#UIEventCallbackSubSpec 

                                                #requestValueChangeSelector: #changeRequest ) 

                                        #label: 'instance' 

                                        #select: false ) 

                                #(#RadioButtonSpec 

                                        #layout: #(#LayoutFrame 1 0.575 4 0 -1 1 20 0 ) 

                                        #name: #classSwitch 

                                        #model: #metaHolder 

                                        #callbacksSpec: 

                                        #(#UIEventCallbackSubSpec 

                                                #requestValueChangeSelector: #changeRequest ) 

                                        #label: 'class' 

                                        #select: true ) ) ) )

    "Created: / 30.10.1997 / 19:07:29 / cg"

!

methodMoveDialogSpec

    "this window spec was automatically generated by the ST/X UIPainter"

    "do not manually edit this - the painter/builder may not be able to

     handle the specification if its corrupted."

    "

     UIPainter new openOnClass:SystemBrowser andSelector:#methodMoveDialogSpec

     SystemBrowser new openDialogInterface:#methodMoveDialogSpec

    "

    <resource: #canvas>

    ^

       #(#FullSpec

          #'window:' 

           #(#WindowSpec

              #'name:' 'uIPainterView'

              #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)

              #'label:' 'move method'

              #'bounds:' #(#Rectangle 0 0 279 118)

          )

          #'component:' 

           #(#SpecCollection

              #'collection:' 

               #(

                 #(#HorizontalPanelViewSpec

                    #'name:' 'horizontalPanelView'

                    #'layout:' #(#LayoutFrame 0 0.0 -35 1.0 0 1.0 -2 1.0)

                    #'component:' 

                     #(#SpecCollection

                        #'collection:' 

                         #(

                           #(#ActionButtonSpec

                              #'name:' 'actionButton2'

                              #'label:' 'cancel'

                              #'tabable:' true

                              #'model:' #cancel

                              #'extent:' #(#Point 133 27)

                          )

                           #(#ActionButtonSpec

                              #'name:' 'actionButton1'

                              #'label:' 'move'

                              #'tabable:' true

                              #'isDefault:' true

                              #'model:' #accept

                              #'extent:' #(#Point 134 27)

                          )

                        )

                    )

                    #'level:' 0

                    #'horizontalLayout:' #fitSpace

                    #'verticalLayout:' #center

                    #'horizontalSpace:' 4

                    #'verticalSpace:' 4

                )

                 #(#LabelSpec

                    #'name:' 'label'

                    #'layout:' #(#LayoutFrame 2 0 2 0 -2 1.0 25 0)

                    #'label:' 'move current method to which class:'

                    #'style:' 

                     #(#Font

                        'helvetica' 'medium'

                        'roman' 12

                    )

                    #'foregroundColor:' #(#Color 0.0 0.0 0.0)

                    #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993)

                    #'adjust:' #left

                )

                 #(#ComboBoxSpec

                    #'name:' 'comboBox1'

                    #'layout:' #(#LayoutFrame 2 0 29 0 -2 1.0 51 0)

                    #'tabable:' true

                    #'model:' #className

                    #'comboList:' #classList

                )

              )

          )

      )

    "Created: 25.6.1997 / 13:45:20 / cg"

    "Modified: 25.6.1997 / 13:46:44 / cg"

! !

!SystemBrowser class methodsFor:'private helpers'!

showNoneFound

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

!

showNoneFound:what

    |rs|

    rs := self classResources.

    super information:((rs string:what) , (rs string:'...\\... 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:aSelectorString 

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

    ^ self

        allCallsOn:aSelectorString 

        in:aCollectionOfClasses 

        ignoreCase:false

!

allCallsOn:aSelectorString in:aCollectionOfClasses ignoreCase:ignoreCase

    "return a collection of methods which send aSelector.

     Methods from classes in aCollectionOfClasses are searched only."

    |sel searchBlock lcString|

    ((aSelectorString ~= '*') 

     and:[(aSelectorString includesMatchCharacters or:[ignoreCase])]) ifTrue:[

        "/ a matchString - need string matching procedure

        searchBlock := [:class :method :s |

                            |src|

                            ignoreCase ifTrue:[

                                lcString := aSelectorString asLowercase.

                            ] ifFalse:[

                                lcString := aSelectorString.

                            ].

                            method isLazyMethod ifTrue:[

                                src := method source.

                                (src notNil and:[src includesMatchString:aSelectorString]) ifTrue:[

                                    method makeRealMethod.

                                    (method literalsDetect:[:aLiteral|

                                        (aLiteral isMemberOf:Symbol) 

                                          and:[(ignoreCase and:[lcString match:aLiteral asLowercase])

                                               or:[ignoreCase not and:[lcString match:aLiteral]]]

                                    ] ifNone:nil) notNil

                                ] ifFalse:[

                                    false

                                ]

                            ] ifFalse:[

                                (method literalsDetect:[:aLiteral|

                                    (aLiteral isMemberOf:Symbol) 

                                      and:[(ignoreCase and:[lcString match:aLiteral asLowercase])

                                           or:[ignoreCase not and:[lcString 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 |

                                |src|

                                method isLazyMethod ifTrue:[

                                    src := method source.

                                    (src notNil and:[src 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 

        withPriority:Processor activePriority-1 to:Processor activePriority

    do:[

        |checkedClasses checkBlock detectedMethods|

        checkedClasses := IdentitySet new.

        list := OrderedCollection new.

        detectedMethods := IdentitySet 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:[