"

 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 ClassHistory

		EmphasisForDifferentPackage EmphasisForModifiedBuffer

		EmphasisForObsoleteCode EmphasisForReadVariable

		EmphasisForWrittenVariable EmphasisForChangedCode'

	poolDictionaries:''

	category:'Interface-Browsers'

!

Object subclass:#BrowserHistoryEntry

	instanceVariableNames:'className meta selector'

	classVariableNames:''

	poolDictionaries:''

	privateIn:SystemBrowser

!

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

    brwsr := self openOnDevice:(Screen current).

    brwsr waitUntilVisible.

    aClass notNil ifTrue:[

"/        cls := aClass.

"/        cls isMeta ifTrue:[

"/            cls := aClass soleInstance

"/        ].

        aClass isMeta ifTrue:[

            brwsr instanceProtocol:false

        ].

        aClass isJavaClass ifTrue:[

            classesName := aClass fullName. 

        ] ifFalse:[

            classesName := aClass name. 

        ].

        brwsr switchToClassNamed:classesName.

        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: / 5.11.2001 / 16:51:02 / cg"

!

openOn:anEnvironment

    ^ self

        openOn:anEnvironment

        label:(self classResources string:'System Browser')

    "

     SystemBrowser openOn:Smalltalk

     SystemBrowser openOn:Demos

    "

!

openOn:aClassEnvironment label:title

    ^ self

        openOn:aClassEnvironment 

        label:title 

        onDevice:(Screen current)

!

openOn:aClassEnvironment label:title onDevice:aDisplayDevice

    |browser|

    browser := self 

                newWithLabel:title

                setupBlock:[:browser | browser environment:aClassEnvironment.

                                       browser setupForAll]

                onDevice:aDisplayDevice.

    ^ browser

!

openOnDevice:aDisplay

    "launch a standard browser on another display."

    self == SystemBrowser ifFalse:[

        ^ super openOnDevice:aDisplay

    ].

    ^ self 

        openOn:Smalltalk

        label:(self classResources string:'System Browser')

        onDevice:aDisplay

    "|d|

     d := XWorkstation new initializeFor:'porty:0'.

     d startDispatch.

     SystemBrowser openOnDevice:d

    "

!

openOnRemoteImageOnHost:aHostName port:portOrNil

    |environment|

    environment := RemoteImage onHost:aHostName port:portOrNil.

    ^ self

        openOn:environment 

        label:(self classResources string:'RemoteImage Browser - %1' with:aHostName)

    "

     SystemBrowser openOnRemoteImageOnHost:'funkfix' port:nil

    "

!

openOnSnapShotImage:anImageFileName

    |environment|

    environment := SnapShotImage for:anImageFileName.

    ^ self

        openOn:environment 

        label:(self classResources string:'Image Browser - %1' with:anImageFileName asFilename baseName)

    "

     SystemBrowser openOnSnapShotImage:('/tmp/stmeas.img')

    "

! !

!SystemBrowser class methodsFor:'Compatibility-ST80'!

newOnClass:aClass

    ^ self browseClass:aClass

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

! !

!SystemBrowser class methodsFor:'accessing-history'!

addToHistory:aClass selector:aSelectorOrNil

    |newEntry oldEntry classHistory|

    (newEntry := self historyEntryForClass:aClass selector:aSelectorOrNil) isNil ifTrue:[^ self].

    classHistory := self classHistory.

    oldEntry := classHistory detect:[:entry | entry className = newEntry className] ifNone:nil.

    oldEntry notNil ifTrue:[

        classHistory removeIdentical:oldEntry.

    ].

    classHistory addFirst:newEntry.

    classHistory size > self visitedHistoryMaxSize ifTrue:[

        classHistory removeLast

    ].

!

checkClassHistory

    "checks the class history for non-existing classes"

    "/ reverse, since we might modify while enumerating

    self classHistory reverseDo:[:histEntry|

        (Smalltalk at: (histEntry className) asSymbol) isBehavior

        ifFalse:[

            self classHistory remove: histEntry

        ]

    ]

!

classHistory

    ClassHistory isNil ifTrue:[

        ClassHistory := List new

    ].

    ^ ClassHistory 

!

classHistory:newCollection

    ClassHistory := newCollection

!

emptyClassHistory

    "removes all class history entries"

    self classHistory removeAll

!

historyEntryForClass:aClass selector:aSelectorOrNil

    |newEntry meta cls|

    aClass isBehavior ifFalse:[^ nil].

    (meta := aClass isMeta) ifTrue:[

        cls := aClass theNonMetaclass.

    ] ifFalse:[

        cls := aClass

    ].

    newEntry := BrowserHistoryEntry new.

    newEntry 

        className:cls name

        meta:meta

        selector:aSelectorOrNil.

    ^ newEntry

    "Modified: / 24.2.2000 / 18:03:52 / cg"

! !

!SystemBrowser class methodsFor:'defaults'!

classHistoryMaxLevels

    ^ 3

!

classHistoryMaxSize

    ^ 15

!

methodTemplate

    "return a method definition template string"

    |s|

    s := TextStream on:''.

    s nextPutAll:'message selector and argument names

    "comment stating purpose of this message"

    |temporaries|

    statement.

    statement.

    "

     optional: comment giving example use

    "

'.

    s cr.

    s emphasis:(UserPreferences current commentEmphasisAndColor).

    s nextPutAll:'"

 change the above template into real code;

 remove this comment.

 Then `accept'' either via the menu 

 or via the keyboard (usually CMD-A).

 You do not need this template; you can also

 select any existing methods code, change it,

 and finally `accept''. The method will then be

 installed under the selector as defined in the

 actual text - no matter which method is selected

 in the browser.

 Or clear this text, type in the method from scratch

 and install it with `accept''.

"

'.

    ^ s contents

!

visitedHistoryMaxSize

    "the maximum number of remembered visited-class-history entries"

    ^ 15

! !

!SystemBrowser class methodsFor:'defaults-presentation'!

emphasisForChangedCode

    ^ UserPreferences current emphasisForChangedCode.

    "

     EmphasisForChangedCode := #underwave

     EmphasisForChangedCode := #color->Color blue

     EmphasisForChangedCode := #color->Color red lightened lightened lightened

    "

    "Created: / 31.10.2001 / 10:15:33 / cg"

!

emphasisForChangedCode:anEmphasis

    EmphasisForChangedCode := anEmphasis

    "

     self emphasisForChangedCode:#underwave

     self emphasisForChangedCode:(#color->Color red lightened lightened lightened)

    "

    "Created: / 31.10.2001 / 10:15:44 / cg"

!

emphasisForDifferentPackage

    ^ UserPreferences current emphasisForDifferentPackage.

    "

     EmphasisForDifferentPackage := nil.

     EmphasisForDifferentPackage := #underwave

     EmphasisForDifferentPackage := #color->Color red lightened lightened lightened

    "

    "Modified: / 31.10.2001 / 10:47:25 / cg"

!

emphasisForDifferentPackage:anEmphasis

    EmphasisForDifferentPackage := anEmphasis

    "

     self emphasisForDifferentPackage:#underwave

     self emphasisForDifferentPackage:(#color->Color red lightened lightened lightened)

    "

!

emphasisForModifiedBuffer

    ^ UserPreferences current emphasisForModifiedBuffer.

!

emphasisForModifiedBuffer:anEmphasis

    EmphasisForModifiedBuffer := anEmphasis

!

emphasisForObsoleteCode

    ^ UserPreferences current emphasisForObsoleteCode.

!

emphasisForObsoleteCode:anEmphasis

    EmphasisForObsoleteCode := anEmphasis

!

emphasisForReadVariable

    ^ UserPreferences current emphasisForReadVariable.

    "

     EmphasisForReadVariable := #underline

     EmphasisForReadVariable := Array with:#underline with:#underlineColor->Color yellow

    "

!

emphasisForReadVariable:anEmphasis

    EmphasisForReadVariable := anEmphasis

    "

     self emphasisForReadVariable:#underline

     self emphasisForReadVariable:(Array with:#underline with:#underlineColor->Color yellow)

    "

!

emphasisForWrittenVariable

    ^ UserPreferences current emphasisForWrittenVariable.

    "

     EmphasisForWrittenVariable := #underline

     EmphasisForWrittenVariable := Array with:#underline with:#underlineColor->Color red lightened

    "

!

emphasisForWrittenVariable:anEmphasis

    EmphasisForWrittenVariable := anEmphasis

    "

     self emphasisForWrittenVariable:#underline

     self emphasisForWrittenVariable:(Array with:#underline with:#underlineColor->Color red lightened)

    "

!

iconForClass:aClass

    |c|

    (aClass isBrowserStartable) ifTrue:[

        aClass isVisualStartable ifTrue:[

            ^ self startableVisualAppIcon

        ].

        ^ self startableClassIcon

    ].

    aClass isLoaded ifFalse:[

        ^ self autoloadedClassIcon

    ].

    c := aClass.

    [c notNil] whileTrue:[

        c == Warning ifTrue:[

            ^ self warningClassIcon

        ].