"{ Encoding: utf8 }"

"

 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' }"

"{ NameSpace: Smalltalk }"

ApplicationModel subclass:#SystemBrowser

	instanceVariableNames:''

	classVariableNames:'CheckForInstancesWhenRemovingClasses ClassHistory

		EmphasisForDifferentPackage EmphasisForModifiedBuffer

		EmphasisForObsoleteCode EmphasisForReadVariable

		EmphasisForWrittenVariable EmphasisForChangedCode

		LastSearchPatterns LastClassSearchBoxShowedFullName'

	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 Tools::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 default open

     SystemBrowser open

    "

!

openInClass:aClass

    "launch a standard browser which immediately switches

     to aClass"

    ^ self openInClass:aClass selector:nil

    "

     SystemBrowser default openInClass:Object

     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. Returns the browser"

    |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 default openOn:Smalltalk

     SystemBrowser default openOn:Demos

     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"

!

lastSearchPatterns

    ^ LastSearchPatterns

!

rememberSearchPattern:aString

    LastSearchPatterns isNil ifTrue:[

        LastSearchPatterns := OrderedCollection new.

    ].

    (LastSearchPatterns includes:aString) ifTrue:[

        LastSearchPatterns remove:aString.

    ] ifFalse:[

        LastSearchPatterns size > 20 ifTrue:[

            LastSearchPatterns removeFirst

        ]

    ].

    LastSearchPatterns addFirst:aString.

    "Modified: / 24-11-2010 / 12:51:31 / cg"

    "Created: / 14-02-2012 / 14:00:24 / cg"

!

visitedClassNamesHistory

    ^ self classHistory

        collect:[:e | e className]

        thenSelect:[:nm | nm notEmptyOrNil]

    "

     Tools::NewSystemBrowser visitedClassNamesHistory

    "

! !

!SystemBrowser class methodsFor:'defaults'!

classHistoryMaxLevels

    ^ 3

!

classHistoryMaxSize

    "returns maximum size of the visited class history"

    Screen current height < 768 ifTrue:[

        ^ 15

    ].

    ^ 20 "/ 15

    "Modified: / 10.2.2000 / 14:07:07 / cg"

!

default

    "convenient getter for the user's preference.

     Returns his choice of browser class"

    ^ UserPreferences systemBrowserClass

    "   

     SystemBrowser default open

    "

!

largeLabelFont

    ^ Label defaultFont scaled:1.2.

!

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.