"

 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 Icons 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 cls|

    brwsr := self openOnDevice:(Screen current).

    brwsr waitUntilVisible.

    cls := aClass.

    cls notNil ifTrue:[

        cls isMeta ifTrue:[

            cls := aClass soleInstance

        ].

        aClass isMeta ifTrue:[

            brwsr instanceProtocol:false

        ].

        aClass isJavaClass ifTrue:[

            brwsr switchToClassNamed:aClass fullName. 

        ] ifFalse:[

            brwsr switchToClassNamed:aClass name. 

        ].

        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: / 14.10.1998 / 15:31:52 / cg"

!

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

    "

!

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

    "

     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|

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

    ClassHistory isNil ifTrue:[

        ClassHistory := OrderedCollection new

    ].

    ClassHistory := ClassHistory select:[:entry | entry className ~= newEntry className].

    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 ? #()

!

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

!

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

abstractMethodIcon

    <resource: #programImage>

    ^ self padLockGrayMiniIcon

!

canvasIcon

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     ImageEditor openOnClass:self andSelector:#canvasIcon

    "

    <resource: #image>

    ^Icon

        constantNamed:#'SystemBrowser canvasIcon'

        ifAbsentPut:[(Depth4Image new) width: 13; height: 11; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@.;.;.;.0@@@@@@@@@@C.;/C.;/@@9&XP9&XP@NY&DNY&D@C&Y!!C&Y!!@@9&XP9&XP@NY&DNY&D@C1DQC1DQ@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255 255 0 0 0 255 0 0 0 255 0 255 255 255 255 0 255 0 255 127 0 0 0 127 0 0 0 127 0 127 127 127 127 0 127 0 127 127 127 127 170 170 170]; mask:((Depth1Image new) width: 13; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'??#?>O?8??#?>O?8??#?>O?8??#?>@@a') ; yourself); yourself]

!

defaultIcon

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self defaultIcon inspect

     ImageEditor openOnClass:self andSelector:#defaultIcon

    "

    <resource: #image>

    ^Icon

        constantNamed:#'SystemBrowser defaultIcon'

        ifAbsentPut:[(Depth4Image new) width: 28; height: 28; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'

@@@@@@@@@@@@@@@@@@@FY&Y&Y&X0@@@@@@@@@@YDQDQDQB@@@@@@@@@@A$QDQDQDH@@@@@@@@@@CH"H"H"H @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@H@@@

@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@B@@@@@@@@@@@@@@@@@@@@@@@@Y&Y&Y&X0@@@@A H"H"A!!DQDQDR@@@@@@@@@@@CH"H"H"H@@@@@H@@@@@@@@@@@

@@@@@@@ @@@@@@@@@@@@@@@@@B@@@@@@@@@@@@@@@@@@@@@@@@Y&Y&Y&X0@@@@A H"H"A%UUUUUR@@@@@@@@@@@CH"H"H"H@@@@@@@@@@@@@@@@@@@@@@@@@

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@H@@@@B@B@ @@H@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

@@@@@@@@@@@@@@@@@@@@@@@@H@@@@@@@@@H@@ @@@@Hb') ; colorMapFromArray:#[0 0 0 0 255 0 127 127 127 170 170 170 255 0 0 255 255 0 255 255 255]; mask:((Depth1Image new) width: 28; height: 28; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'

??0@@O?<@@C??@@@??0@@O?<@@C??@@@@ @@@@H@@@@B@?? A0O?8@_??>@G@?? @ O?8@H@@@@B@?? A0O?8@_??>@G@?? @@O?8@@@@@@@@@@@9O\7\IRT

QDBD%DQ@!!OH''HHRQEABT$QPP99]7\@@a') ; yourself); yourself]

!

fileImageIcon

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self fileImageIcon inspect

     ImageEditor openOnClass:self andSelector:#fileImageIcon