"

 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

    |browser|

    browser := self 

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

                setupBlock:[:browser | browser environment:anEnvironment.

                                       browser setupForAll]

                onDevice:(Screen current).

    ^ browser

    "

     SystemBrowser openOn:Smalltalk

     SystemBrowser openOn:Demos

    "

!

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

    "

!

openOnRemoteImageOnHost:aHostName port:portOrNil

    |environment browser|

    environment := RemoteImage onHost:aHostName port:portOrNil.

    browser := self 

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

                setupBlock:[:browser | browser environment:environment.

                                       browser setupForAll]

                onDevice:(Screen current).

    ^ browser

    "

     SystemBrowser openOnRemoteImageOnHost:'funkfix' port:nil

    "

!

openOnSnapShotImage:anImageFileName

    |environment browser|

    environment := SnapShotImage for:anImageFileName.

    browser := self 

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

                setupBlock:[:browser | browser environment:environment.

                                       browser setupForAll]

                onDevice:(Screen current).

    ^ browser

    "

     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.

 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

    EmphasisForChangedCode isNil ifTrue:[

        EmphasisForChangedCode := UserPreferences current at:#emphasisForChangedCode ifAbsent:nil.

        EmphasisForChangedCode isNil ifTrue:[EmphasisForChangedCode := #color->Color red darkened].

    ].

    ^ EmphasisForChangedCode

    "

     EmphasisForChangedCode := #underwave

     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

    EmphasisForDifferentPackage isNil ifTrue:[

        EmphasisForDifferentPackage := UserPreferences current at:#emphasisForDifferentPackage ifAbsent:nil.

        EmphasisForDifferentPackage isNil ifTrue:[EmphasisForDifferentPackage := #color->Color brown darkened].

    ].

    ^ 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

    EmphasisForModifiedBuffer isNil ifTrue:[

        EmphasisForModifiedBuffer := UserPreferences current at:#emphasisForModifiedBuffer ifAbsent:nil.

        EmphasisForModifiedBuffer isNil ifTrue:[EmphasisForModifiedBuffer := #color->Color red darkened].

    ].

    ^ EmphasisForModifiedBuffer

!

emphasisForModifiedBuffer:anEmphasis

    EmphasisForModifiedBuffer := anEmphasis

!

emphasisForObsoleteCode

    EmphasisForObsoleteCode isNil ifTrue:[

        EmphasisForObsoleteCode := UserPreferences current at:#emphasisForObsoleteCode ifAbsent:nil.

        EmphasisForObsoleteCode isNil ifTrue:[EmphasisForObsoleteCode := #color->Color red].

    ].

    ^ EmphasisForObsoleteCode

!

emphasisForObsoleteCode:anEmphasis

    EmphasisForObsoleteCode := anEmphasis

!

emphasisForReadVariable

    EmphasisForReadVariable isNil ifTrue:[

        EmphasisForReadVariable := UserPreferences current at:#emphasisForReadVariable ifAbsent:nil.

        EmphasisForReadVariable isNil ifTrue:[EmphasisForReadVariable := #underline].

    ].

    ^ 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

    EmphasisForWrittenVariable isNil ifTrue:[

        EmphasisForWrittenVariable := UserPreferences current at:#emphasisForWrittenVariable ifAbsent:nil.

        EmphasisForWrittenVariable isNil ifTrue:[EmphasisForWrittenVariable := Array with:#underline with:#underlineColor->Color red].

    ].

    ^ 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)

    "

! !

!SystemBrowser class methodsFor:'image specs'!