"

 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:#BrowserView

	instanceVariableNames:'classCategoryListView classListView methodCategoryListView

		methodListView classMethodListView codeView classToggle

		instanceToggle currentNamespace currentClassCategory

		currentClassHierarchy currentClass currentMethodCategory

		currentMethod currentSelector showInstance actualClass fullClass

		lastMethodCategory aspect variableListView fullProtocol

		lockUpdates autoSearch myLabel acceptClass lastSourceLogMessage

		lastCategory lastModule lastPackage lastMethodMoveClass

		namespaceList allNamespaces'

	classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon

		StopIcon TraceIcon'

	poolDictionaries:''

	category:'Interface-Browsers'

!

!BrowserView 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 intermediate versions of BrowserView/SystemBrowser. 

    All action is (currently) still done here in BrowserView, although the

    SystemBrowsers class methods are used to startup a browser.

    This will certainly change ...

    [author:]

        Claus Gittinger

"

! !

!BrowserView class methodsFor:'initialization'!

initialize

    "Browser configuration;

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

    "

     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.

    "

     setting this to true makes the browser remember the aspect shown

     in the classList and show this aspect when a new class is selected.

     If false, it always switches to the classes definition

    "

    RememberAspect := true.

    "

     CheckForInstancesWhenRemovingClasses := true

     CheckForInstancesWhenRemovingClasses := false

     RememberAspect := true

     RememberAspect := false

    "

    "Created: 23.11.1995 / 11:35:58 / cg"

    "Modified: 23.11.1995 / 11:36:34 / cg"

! !

!BrowserView class methodsFor:'cleanup'!

lowSpaceCleanup

    DefaultIcon := nil

    "Created: 18.4.1996 / 16:46:40 / cg"

! !

!BrowserView class methodsFor:'defaults'!

defaultIcon

    DefaultIcon isNil ifTrue:[

        DefaultIcon := Image fromFile:'bitmaps/SBrowser.xbm' resolution:100

    ].

    ^ DefaultIcon

    "Modified: 1.1.1970 / 14:04:42 / cg"

! !

!BrowserView methodsFor:'change & update'!

refetchClass

    "after a class definition change in another browser,

     this is sent to update (otherwise, we'd still refer to the obsolete class)"

"/    currentClass := Smalltalk at:(currentClass name asSymbol).

    self switchToClass:(Smalltalk at:(currentClass name asSymbol)).

"/    showInstance ifTrue:[

"/        actualClass := currentClass

"/    ] ifFalse:[

"/        actualClass := currentClass class

"/    ].

    "Created: 8.2.1996 / 13:22:27 / cg"

    "Modified: 8.2.1996 / 13:40:18 / cg"

!

update:something with:someArgument from:changedObject

    |list selector oldMethod|

    (changedObject == ObjectMemory) ifTrue:[

        (something == #earlyRestart 

        or:[something == #restarted

        or:[something == #returnFromSnapshot]]) ifTrue:[

            "/ those are to be ignored.

            ^ self

        ]

    ].

    "

     avoid update/warn after my own changes

    "

    lockUpdates == true ifTrue:[

"/         'ignored my change' printNL.

        ^ self

    ].

"/ changedObject print. ' ' print. someArgument print. ' ' print.

"/ something printNL.

    (changedObject == Smalltalk) ifTrue:[

        allNamespaces := nil.

        namespaceList notNil ifTrue:[

            self setListOfNamespaces

        ].

        something == #newClass ifTrue:[

            (currentClass notNil

            and:[someArgument name = currentClass name]) ifTrue:[

                "

                 the current class was autoloaded

                "

                self warnLabel:'the selected class has changed'.

                self updateClassListWithScroll:false.

            ].

            ((someArgument category = currentClassCategory)

            or:[currentClassCategory notNil

                and:[currentClassCategory startsWith:'*']]) ifTrue:[

                self updateClassListWithScroll:false.

            ].

            someArgument category ~= currentClassCategory ifTrue:[

                "

                 category new ?

                "

                (classCategoryListView notNil 

                and:[(list := classCategoryListView list) notNil

                and:[(list includes:someArgument category) not]])

                ifTrue:[

                    self updateClassCategoryListWithScroll:false.

                ]

            ].

            ^ self

        ].

        something == #classRemove ifTrue:[

            someArgument == currentClass ifTrue:[

                self warnLabel:'the selected class was removed'.

                ^ self

            ].

            " fall into general update "

        ].

        "

         any other (unknown) change 

         with the Smalltalk dictionary ...

        "

        self updateClassCategoryListWithScroll:false.

        self updateClassListWithScroll:false.

        ^ self

    ].

    changedObject isBehavior ifTrue:[

        "/

        "/ its a class, that has changed

        "/

        fullClass ifTrue:[

            "/

            "/ full-class browser ...

            "/ (must check for both class and metaclass changes)

            "/

            (currentClass == changedObject

            or:[currentClass class == changedObject]) ifTrue:[

                self warnLabel:'class was changed - the code shown may be obsolete'.

            ].

            ^ self

        ].

        (currentClass notNil 

        and:[changedObject name = currentClass name]) ifTrue:[

            "/

            "/ its the current class that has changed

            "/

            something == #methodDictionary ifTrue:[

                "/ new feature: changeArg may be an array consisting of

                "/ the selector and the oldMethod

                someArgument isArray ifTrue:[

                    oldMethod := someArgument at:2.

                    selector := someArgument at:1.

                ] ifFalse:[

                    selector := someArgument

                ].

                (selector isSymbol) ifTrue:[

                    |changedMethod s1 s2|

                    "

                     the method with selector was changed or removed

                    "

                    self updateMethodCategoryListWithScroll:false.

                    self updateMethodListWithScroll:false.

                    selector == currentSelector ifTrue:[

                        "

                         special care here: the currently shown method has been

                         changed somehow in another browser (or via fileIn)

                        "

                        changedMethod := currentClass compiledMethodAt:currentSelector.

                        changedMethod isNil ifTrue:[

                            self warnLabel:'the method shown was removed'.

                            ^ self

                        ].

                        "compare the source codes"

                        currentMethod notNil ifTrue:[

                            s1 := changedMethod source asString asCollectionOfLines copy.

                            [s1 last isEmpty] whileTrue:[s1 removeLast].

                            s2 := codeView contents  asCollectionOfLines copy.

                            [s2 last isEmpty] whileTrue:[s2 removeLast].

                            s1 = s2 ifFalse:[

                                self warnLabel:'method has changed - the code shown may be obsolete'.

                            ]

                        ].

                        ^ self    

                    ].

                ]

            ].

            something == #comment ifTrue:[

                "

                 the class has changed its comment; we dont care, except if

                 currently showing the comment

                "

                aspect == #comment ifTrue:[

                    codeView modified ifFalse:[

                        self refetchClass.

                        self updateCodeView

                    ] ifTrue:[

                        self warnLabel:'the comment has changed - reselect to update'.

                    ]

                ].

                self refetchClass.

                ^ self

            ].

            something == #definition ifTrue:[

                "

                 the class has changed its definition.

                 Warn, except if showing a method.

                "

                aspect notNil ifTrue:[

                    codeView modified ifFalse:[

                        self refetchClass.

                        self updateCodeView

                    ] ifTrue:[

                        self warnLabel:'the classes definition has changed - reselect to update'.

                    ].

                    ^ self

                ].

            ].

            "/

            "/ if I am not showing code update if unmodified,

            "/ warn if modified

            "/

            aspect notNil ifTrue:[

                codeView modified ifFalse:[

                    self refetchClass.

                    self updateCodeView

                ] ifTrue:[

                    self warnLabel:'the classes has changed - reselect to update'.

                ].

                ^ self

            ].

            "

             get the class again - in case of a changed class definition,

             we are otherwise refering to the obsolete old class

            "

            self refetchClass.

            self updateMethodCategoryListWithScroll:false.

            "dont update codeView ...."

            "self update"

            self warnLabel:'the class has changed'.

            ^ self

        ].

        "

         any other class has changed (but not its organization, since

         that is cought in the above case).

         We are not interested in it - except, if showing fullProtocol

         or hierarchy ...

        "

        currentClassHierarchy notNil ifTrue:[

            fullProtocol ifTrue:[

                (currentClass isSubclassOf:changedObject) ifTrue:[

                    self warnLabel:'some superclass has changed - reselect to update'.

                ]

            ] ifFalse:[

                ((currentClass isSubclassOf:changedObject)

                or:[changedObject isSubclassOf:currentClass]) ifTrue:[

                    self warnLabel:'some superclass has changed - reselect to update'.

                ]                

            ]

        ].

        ^ self

    ].

    (changedObject isMethod) ifTrue:[

    ]

    "Modified: 20.12.1996 / 18:57:49 / cg"

! !

!BrowserView methodsFor:'class category list menu'!

classCategoryClone

    "open a new SystemBrowser showing the same method as I do"

    SystemBrowser openInClass:actualClass selector:currentSelector

    "Created: 14.9.1995 / 10:55:20 / claus"

    "Modified: 14.9.1995 / 10:59:31 / claus"

!

classCategoryFileOut

    "create a file 'categoryName' consisting of all classes in current category"

    |aStream fileName|

    self checkClassCategorySelected ifFalse:[^ self].

    (currentClassCategory startsWith:'*') ifTrue:[

        self warn:(resources string:'try a real category').

        ^ self

    ].

    fileName := currentClassCategory asString.

    fileName replaceAll:Character space by:$_.

    "

     this test allows a smalltalk to be built without Projects/ChangeSets

    "

    Project notNil ifTrue:[

        fileName := Project currentProjectDirectory , fileName.

    ].

    self withWaitCursorDo:[

        "

         if file exists, save original in a .sav file

        "

        fileName asFilename exists ifTrue:[

            self busyLabel:'saving existing %1' with:fileName.

            fileName asFilename copyTo:(fileName , '.sav')

        ].

        aStream := FileStream newFileNamed:fileName.

        aStream isNil ifTrue:[

            self warn:'cannot create: %1' with:fileName

        ] ifFalse:[

            self busyLabel:'writing: %1' with:fileName.

            self allClassesInCategory:currentClassCategory inOrderDo:[:aClass |

                aClass isPrivate ifFalse:[

                    self busyLabel:'writing: %1' with:fileName.

                    aClass fileOutOn:aStream.

                ]

            ].

            aStream close.

        ]

    ].

    self normalLabel.

    "Modified: 23.12.1996 / 10:30:35 / cg"

!

classCategoryFileOutBinaryEach

    "fileOut each class in the current category as binary bytecode."

    |mode|

    (currentClassCategory startsWith:'*') ifTrue:[

        self warn:(resources string:'try a real category').

        ^ self

    ].

    mode := Dialog choose:(resources string:'save including sources ?')

                   labels:(resources array:#('cancel' 'discard' 'by file reference' 'include source'))

                   values:#(nil #discard #reference #keep)

                   default:#keep.

    mode isNil ifTrue:[^ self].

    self withWaitCursorDo:[

        self allClassesInCategory:currentClassCategory do:[:aClass |

            aClass isPrivate ifFalse:[

                self busyLabel:'saving binary of: %1' with:aClass name.

                Class fileOutErrorSignal handle:[:ex |

                    self warn:'cannot create: %1' with:ex parameter.

                    ex return.

                ] do:[

                    aClass binaryFileOutWithSourceMode:mode.

                ]

            ]

        ].

        self normalLabel.

    ]

    "Created: 25.1.1996 / 17:27:45 / cg"

    "Modified: 20.12.1996 / 22:35:54 / cg"

!

classCategoryFileOutEach

    (currentClassCategory startsWith:'*') ifTrue:[

        self warn:(resources string:'try a real category').

        ^ self

    ].

    self withWaitCursorDo:[

        self allClassesInCategory:currentClassCategory do:[:aClass |

            aClass isPrivate ifFalse:[

                self busyLabel:'saving: %1' with:aClass name.

                Class fileOutErrorSignal handle:[:ex |

                    self warn:'cannot fileOut: %1\(%2)' with:aClass name with:ex errorString.

                    ex return.

                ] do:[

                    aClass fileOut

                ]

            ]

        ].

        self normalLabel.

    ]

    "Modified: 20.12.1996 / 22:36:15 / cg"

!

classCategoryFindClass