"

 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

"

    Notice: SystemBrowser has been completely rewritten to be an instance

    of ApplicationModel. This rewritten version is found under NewSystemBrowser.

    Because the class protocol here was used by many others, it is left here

    as an instance-less functionality provider only.

    written winter 89 by claus.

    [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

     SystemBrowser openOnRemoteImageOnHost:'192.168.8.1' 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) 

                                              "and:[entry selector = newEntry selector]"] ifNone:nil.

    oldEntry notNil ifTrue:[

        classHistory removeIdentical:oldEntry.

    ].

    classHistory addFirst:newEntry.

    classHistory size > self visitedHistoryMaxSize ifTrue:[

        classHistory removeLast

    ].

    SystemBrowser changed:#visitedClassHistory with:classHistory.

    "Modified: / 05-07-2011 / 16:49:57 / cg"

!

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 removeIdentical: histEntry

        ]

    ]

    "Modified: / 20-07-2011 / 11:59:22 / cg"

!

classHistory

    ClassHistory isNil ifTrue:[

        ClassHistory := List new

    ].

    ^ ClassHistory 

!

classHistory:newCollection

    ClassHistory := newCollection

!

emptyClassHistory

    "removes all class history entries"

    |classHistory|

    classHistory := self classHistory.

    classHistory removeAll.

    SystemBrowser changed:#visitedClassHistory with:classHistory.

    "Modified: / 20-11-2006 / 12:29:42 / cg"

!

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"

!

visitedClassNamesHistory

    ^ self classHistory

        collect:[:e | e className]

        thenSelect:[:nm | nm notEmptyOrNil]

! !

!SystemBrowser class methodsFor:'defaults'!

classHistoryMaxLevels

    ^ 3

!

classHistoryMaxSize

    ^ 15

!

methodTemplate

    "return a method definition template string or nil"

    ^ SmalltalkLanguage instance methodTemplate

!

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

    "now ask the class for its browser symbol; thats a key/selector in the

     ToolbarIconLibrary"

    aClass withAllSuperclassesDo:[:eachCls |

        | iconSymbol |

        iconSymbol := eachCls iconInBrowserSymbol.

        iconSymbol notNil ifTrue:[

            ^ ToolbarIconLibrary perform:iconSymbol

        ].

    ].

    ^ nil

    "Created: / 17-08-2006 / 09:11:27 / cg"

    "Modified: / 20-07-2007 / 09:01:43 / cg"

!

resourceIconForMethod:aMethod

    |resources|

    (resources := aMethod resources) isNil ifTrue:[^ nil].

    (resources includesKey:#obsolete) ifTrue:[

        ^ self deprecatedMethodIcon

    ].

    (resources includesKey:#canvas) ifTrue:[

        ^ self canvasIcon

    ].

    (resources includesKey:#menu) ifTrue:[

        ^ self menuIcon

    ].

    (resources includesKey:#image) ifTrue:[

        ^ self imageIcon

    ].

    (resources includesKey:#fileImage) ifTrue:[

        ^ self fileImageIcon

    ].

    (resources includesKey:#programImage) ifTrue:[

        ^ self programImageIcon

    ].