Fixes for Java (and possibly other languages)
- in the class browser, if it is full source browser, only scroll to
method's source line when method is selected.
- show field type for Java classes in variable list.
"
COPYRIGHT (c) 2000 by eXept Software AG
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: Tools }"
BrowserList subclass:#VariableList
instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName
selectedVariableEntries showWarningAboutMissingEntryInXmlSpec'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers-New'
!
Object subclass:#VariableEntry
instanceVariableNames:'label application class name type icon sortingByNameHolder'
classVariableNames:''
poolDictionaries:''
privateIn:VariableList
!
!VariableList class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2000 by eXept Software AG
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
"
I implement the variable list (below class list) in the new system browser
"
! !
!VariableList class methodsFor:'interface specs'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::VariableList andSelector:#windowSpec
Tools::VariableList new openInterface:#windowSpec
Tools::VariableList open
"
<resource: #canvas>
^
#(FullSpec
name: windowSpec
window:
(WindowSpec
label: 'VariableList'
name: 'VariableList'
min: (Point 0 0)
bounds: (Rectangle 0 0 300 300)
)
component:
(SpecCollection
collection: (
(SequenceViewSpec
name: 'List'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
tabable: true
model: selectedVariableEntries
menu: menuHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
miniScrollerHorizontal: true
isMultiSelect: true
valueChangeSelector: selectionChangedByClick
useIndex: false
sequenceList: variableList
doubleClickChannel: doubleClickChannel
)
)
)
)
! !
!VariableList class methodsFor:'plugIn spec'!
aspectSelectors
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this. If it is corrupted,
the UIPainter may not be able to read the specification."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#(#doubleClickChannel #action )
#classHolder
#forceGeneratorTrigger
#immediateUpdate
#inGeneratorHolder
#menuHolder
#outGeneratorHolder
#packageFilter
#selectedVariables
#selectionChangeCondition
#updateTrigger
#showClassVarsInVariableList
#slaveMode
#sortVariablesByName
).
! !
!VariableList methodsFor:'aspects'!
classHolder
classHolder isNil ifTrue:[
classHolder := #() asValue.
classHolder addDependent:self
].
^ classHolder
!
classHolder:aValueHolder
classHolder notNil ifTrue:[
classHolder removeDependent:self
].
classHolder := aValueHolder.
classHolder notNil ifTrue:[
classHolder isBehavior ifTrue:[self error:'should not happen'].
classHolder addDependent:self
].
"Modified: / 11-07-2011 / 17:04:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
defaultSlaveModeValue
^ false.
!
selectedVariableEntries
<resource: #uiAspect>
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
selectedVariableEntries isNil ifTrue:[
selectedVariableEntries := #() asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
selectedVariableEntries addDependent:self.
"/ selectedVariableEntries onChangeSend:#selectedVariableEntriesChanged to:self.
].
^ selectedVariableEntries.
"Modified: / 12-04-2011 / 15:49:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedVariables
^ self selectionHolder
!
selectedVariables:aValueHolder
^ self selectionHolder:aValueHolder
!
showClassVarsInVariableList
showClassVars isNil ifTrue:[
showClassVars := false asValue.
showClassVars addDependent:self
].
^ showClassVars
!
showClassVarsInVariableList:aValueHolder
showClassVars notNil ifTrue:[
showClassVars removeDependent:self
].
showClassVars := aValueHolder.
showClassVars notNil ifTrue:[
showClassVars addDependent:self
].
!
showingInheritedClassVars
^ false
"/ ^ true
!
sortVariablesByName
sortVariablesByName isNil ifTrue:[
sortVariablesByName := false asValue.
sortVariablesByName addDependent:self
].
^ sortVariablesByName
!
sortVariablesByName:aValueHolder
"/ self assert:(aValueHolder value isBoolean).
sortVariablesByName notNil ifTrue:[
sortVariablesByName removeDependent:self
].
sortVariablesByName := aValueHolder.
sortVariablesByName notNil ifTrue:[
sortVariablesByName addDependent:self
].
!
variableList
variableList isNil ifTrue:[
variableList := ValueHolder new
].
^ variableList
! !
!VariableList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|selectedClasses changedClass anyChange|
self inSlaveModeOrInvisible ifTrue:[self invalidateList. ^ self].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList
].
"/ self invalidateList.
^ self
].
changedObject == classHolder ifTrue:[
self invalidateList.
^ self
].
changedObject == showClassVars ifTrue:[
self invalidateList.
^ self.
].
changedObject == sortVariablesByName ifTrue:[
self invalidateList.
^ self.
].
changedObject == environment ifTrue:[
(something == #projectOrganization) ifTrue:[^ self].
(something == #currentChangeSet) ifTrue:[^ self].
(something == #aboutToAutoloadClass) ifTrue:[^ self].
(something == #classDefinition
or:[ (something == #newClass)
or:[ something == #classVariables and:[showClassVars value == true]]])
ifTrue:[
changedClass := aParameter.
selectedClasses := classHolder value.
selectedClasses notNil ifTrue:[
selectedClasses isSequenceable ifFalse:[
selectedClasses := selectedClasses asOrderedCollection
].
selectedClasses keysAndValuesDo:[:idx :cls | |nm|
cls notNil ifTrue:[
cls isObsolete ifTrue:[
cls isMeta ifTrue:[
nm := cls theNonMetaclass name.
selectedClasses at:idx put:(environment at:nm) class.
] ifFalse:[
nm := cls name.
selectedClasses at:idx put:(environment at:nm).
].
anyChange := true.
] ifFalse:[
(cls == aParameter
or:[something == #classVariables
and:[showClassVars value == true
and:[cls theNonMetaclass == aParameter theNonMetaclass]]]) ifTrue:[
anyChange := true.
]
]
]
].
(selectedClasses includes:nil) ifTrue:[
"/ can happen, if a selected class is removed...
"/ self halt:'should this happen ?'.
"/ fix it ...
selectedClasses := selectedClasses select:[:each | each notNil].
classHolder value:selectedClasses.
anyChange := true.
].
anyChange == true ifTrue:[
self invalidateList.
^ self
].
].
^ self
].
] ifFalse:[
changedObject isBehavior ifTrue:[
anyChange := false.
selectedClasses := classHolder value.
selectedClasses notNil ifTrue:[
selectedClasses keysAndValuesDo:[:idx :cls | |nm|
cls isObsolete ifTrue:[
nm := cls name.
selectedClasses at:idx put:(environment at:nm).
anyChange := true.
]
].
anyChange == true ifTrue:[
self invalidateList.
^ self
].
(selectedClasses includesIdentical:something) ifTrue:[
self invalidateList.
^ self
].
].
^ self
].
].
super delayedUpdate:something with:aParameter from:changedObject
"Modified: / 01-03-2012 / 09:18:11 / cg"
!
enqueueDelayedUpdateList
super enqueueDelayedUpdateList
"Created: / 01-03-2012 / 09:06:42 / cg"
!
makeDependent
environment addDependent:self
!
makeIndependent
environment removeDependent:self
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder"
!
update:something with:aParameter from:changedObject
"/ ^ self delayedUpdate:something with:aParameter from:changedObject.
changedObject == environment ifTrue:[
something == #methodDictionary ifTrue:[
^ self
].
something == #methodTrap ifTrue:[
^ self
].
something == #methodCoverageInfo ifTrue:[
^ self
].
something == #methodInClass ifTrue:[
^ self
].
something == #methodInClassRemoved ifTrue:[
^ self
].
something == #classComment ifTrue:[
^ self.
].
].
"/ self window sensor isNil ifTrue:[
"/ "/ I am not visible ...
"/ self invalidateList.
"/ ^ self
"/ ].
changedObject == selectedVariableEntries ifTrue:[
self selectedVariables value:
((selectedVariableEntries value ? #())
collect:[:e|e name]).
^self.
].
super update:something with:aParameter from:changedObject
"Modified: / 12-04-2011 / 15:54:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-07-2011 / 18:52:44 / cg"
! !
!VariableList methodsFor:'generators'!
makeGenerator
! !
!VariableList methodsFor:'private'!
commonPostBuild
|list|
super commonPostBuild.
list := builder componentAt:#List.
list notNil ifTrue:[
list selectConditionBlock:[:item | self selectionChangeAllowed:item].
list ignoreReselect:false.
].
!
commonSubClassIn:classes
"return true if there is a common subclass"
|theCommonSubClass "classesByInheritance"|
theCommonSubClass := nil.
classes do:[:eachClass |
theCommonSubClass isNil ifTrue:[
theCommonSubClass := eachClass
] ifFalse:[
(eachClass isSubclassOf:theCommonSubClass) ifTrue:[
theCommonSubClass := eachClass
] ifFalse:[
(theCommonSubClass isSubclassOf:eachClass) ifFalse:[
^ nil
]
]
]
].
^ theCommonSubClass.
"/ classesByInheritance := classes topologicalSort:[:a :b | a isSubclassOf:b].
"/ classesByInheritance keysAndValuesDo:[:index :eachClass |
"/ "/ all classes after that one must be superclasses ...
"/ classesByInheritance from:index+1 to:classesByInheritance size do:[:otherClass |
"/ (eachClass isSubclassOf:otherClass) ifFalse:[
"/ ^ nil.
"/ ]
"/ ].
"/ ].
"/ ^ classesByInheritance first
!
iconInBrowserForVariable:varName in:aClass
"variables for which an entry is found in the xml-spec (if any) are marked
with an <xml>-icon."
(Expecco::ExpeccoXMLDecoder notNil
and:[aClass canUnderstand: #xmlSpecForObject:]) ifTrue:[
Error handle:[:ex |
] do:[
(Expecco::ExpeccoXMLDecoder xmlSpecForObject:aClass basicNew)
do:[:spec | spec getter = varName ifTrue:[
^ SystemBrowser instVarOverlayXmlSpec
]
].
].
].
^ nil
"Created: / 12-04-2011 / 19:58:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-07-2011 / 18:32:47 / cg"
"Modified: / 22-06-2012 / 13:17:28 / sr"
!
listEntryForClass: cls name:name
" (showWarningAboutMissingEntryInXmlSpec not
and:[Expecco::ExpeccoXMLDecoder notNil
and:[cls canUnderstand: #xmlSpecFor:]]) ifTrue:
[| hasSpecEntry |
hasSpecEntry := false.
(Expecco::ExpeccoXMLDecoder xmlSpecForObject:cls basicNew)
do:[:spec|spec getter = name ifTrue:
[
hasSpecEntry := true]].
showWarningAboutMissingEntryInXmlSpec := hasSpecEntry not]. "
|entry|
entry := VariableEntry application: self class: cls name: name.
entry sortingByNameHolder:sortVariablesByName.
^ entry
"Created: / 12-04-2011 / 15:41:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 12-04-2011 / 21:36:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
listEntryForClass: cls name:name info: classInfo
| nm entry |
nm := name.
"/ Hack for Java classes to display field type
cls theNonMetaclass isJavaClass ifTrue:[
| field |
field := cls theNonMetaclass lookupFieldFor:name static: (cls isMetaclass) onlyPublic: false.
field notNil ifTrue:[
nm := nm asText ,
' ' ,
(('< ' , (JavaMethod fieldTypeFromStream: (field descriptor readStream) in: cls theNonMetaclass javaPackage) , ' >')
asText colorizeAllWith: Color brown).
].
].
entry := Tools::VariableList::VariableEntry application: self class: cls name: nm.
entry sortingByNameHolder:sortVariablesByName.
classInfo notNil ifTrue:[
entry type: (classInfo infoForInstvarOrNil: name).
].
^entry
"Created: / 27-11-2011 / 17:17:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 09-09-2013 / 01:44:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
listOfVariables
|nameList numClasses classes class commonSubclass commonSuperclass showingClassVars
sortByName classesAlreadyProcessed hasSmallSense smallSenseManager info |
classHolder isNil ifTrue:[
"/ testing
^ #()
].
hasSmallSense := (ConfigurableFeatures includesFeature:'SmallSenseEnabled')
and:[(Smalltalk at: #'SmallSense::Manager') notNil].
hasSmallSense ifTrue:[
smallSenseManager := (Smalltalk at: #'SmallSense::Manager') instance.
].
showingClassVars := self showClassVarsInVariableList value == true.
sortByName := self sortVariablesByName value.
"/ self assert:(sortByName isBoolean).
classes := classHolder value.
(numClasses := classes size) == 0 ifTrue:[^ #() ].
numClasses > 1 ifTrue:[
"/ multiple classes - see if there is a common subclass ...
commonSubclass := self commonSubClassIn:classes.
commonSubclass notNil ifTrue:[
"/ yes - treat like a single class
classes := Array with:(commonSubclass).
numClasses := 1.
].
"/ commonSuperclass := Behavior commonSuperclassOf:classes.
"/ commonSuperclass notNil ifTrue:[
"/ "/ yes - treat like a single class
"/ classes := Array with:(commonSuperclass).
"/ numClasses := 1.
"/ ].
].
numClasses > 1 ifTrue:[
"/ multiple classes - sort alphabetically ...
"/ unless there is a common subclass ...
nameList := Set new.
classesAlreadyProcessed := IdentitySet new.
classes do:[:eachClass |
|class|
class := eachClass.
"/ showingClassVars ifTrue:[
"/ class := class theNonMetaclass
"/ ].
hasSmallSense ifTrue:[
info := smallSenseManager infoForClassOrNil: class.
].
(classesAlreadyProcessed includes:class) ifFalse:[
showingClassVars ifTrue:[
self showingInheritedClassVars ifTrue:[
class theNonMetaclass withAllSuperclassesDo:[:cls|
hasSmallSense ifTrue:[
info := smallSenseManager infoForClassOrNil: cls.
].
(classesAlreadyProcessed includes:cls) ifFalse:[
nameList addAll:
(cls classVarNames collect:[:nm|self listEntryForClass: cls name: nm info: info]).
classesAlreadyProcessed add:cls.
]
]
] ifFalse:[
nameList addAll:
(class classVarNames collect:[:nm|self listEntryForClass: class name: nm info: info ])
]
] ifFalse:[
class withAllSuperclassesDo:[:cls|
(classesAlreadyProcessed includes:cls) ifFalse:[
nameList addAll:
(cls instVarNames collect:[:nm|self listEntryForClass: cls name: nm info: info ]).
classesAlreadyProcessed add:cls.
]
]
]
]
].
nameList := nameList asOrderedCollection.
] ifFalse:[
"/ only a single class - sort by inheritance
class := classes first.
nameList := OrderedCollection new.
class notNil ifTrue:[
showingClassVars ifTrue:[
class := class theNonMetaclass
].
class withAllSuperclassesDo:[:cls|
|varNames|
(hasSmallSense and:[showingClassVars not]) ifTrue:[
info := smallSenseManager infoForClassOrNil: cls.
].
varNames := showingClassVars ifTrue:[ cls classVarNames ] ifFalse:[ cls instVarNames ].
varNames copy reverse do:[:varName|
nameList addFirst: (self listEntryForClass: cls name: varName info: info).
].
sortByName ifFalse:[
nameList addFirst:(("'----- ' , "cls nameInBrowser" , ' -----'") asText colorizeAllWith: Color gray).
]
].
].
].
(numClasses > 1 or:[sortByName]) ifTrue:[
nameList := nameList asSortedCollection:[:a :b|a name < b name].
].
^ nameList
"Created: / 05-02-2000 / 13:42:11 / cg"
"Modified: / 08-08-2011 / 16:20:58 / cg"
"Modified: / 02-09-2013 / 13:13:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postBuildWith:aBuilder
|listView|
(listView := aBuilder componentAt:#List) notNil ifTrue:[
listView scrollWhenUpdating:#end
].
super postBuildWith:aBuilder
!
release
super release.
classHolder removeDependent:self.
showClassVars removeDependent:self.
!
selectionChangeAllowed:index
| entry |
^((entry := variableList value at:index) isString" and:[entry startsWith:'---']") not.
"Modified: / 28-04-2011 / 13:18:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateList
| prevSelection newSelection newList oldList selectedVariablesHolder|
oldList := self variableList value copy.
showWarningAboutMissingEntryInXmlSpec := false.
newList := self listOfVariables.
newList ~= variableList value ifTrue:[
selectedVariablesHolder := self selectedVariableEntries.
prevSelection := (self selectedVariables value "selectedVariablesHolder value" copy) ? #().
variableList value:newList.
newSelection := newList select:[:item | prevSelection includes:item string].
"/ newSelection := prevSelection select:[:item | newList includes:item].
newSelection size > 0 ifTrue:[
"/ force change (for dependents)
"/ selectedVariablesHolder value:nil.
selectedVariablesHolder
setValue:newSelection;
removeDependent:self;
changed;
addDependent:self.
] ifFalse:[
prevSelection := selectedVariablesHolder value.
selectedVariablesHolder value:nil.
].
(prevSelection size > 0 or:[newSelection size > 0
"and:[ prevSelection ~= newSelection]"]) ifTrue:[
self updateOutputGenerator.
].
].
(showWarningAboutMissingEntryInXmlSpec and:[self topApplication respondsTo: #showMessage:])
ifTrue:
[
self topApplication showMessage:
'One or more instance variables are not listed in #xmlSpecFor:'.
].
showWarningAboutMissingEntryInXmlSpec := false.
listValid := true.
"Modified: / 05-08-2011 / 12:34:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-03-2012 / 15:55:47 / cg"
! !
!VariableList::VariableEntry class methodsFor:'instance creation'!
application: app class: aClass name: aString
^self new application: app; class: aClass; name: aString
"Created: / 12-04-2011 / 19:53:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
class: aClass name: aString
^self new class: aClass; name: aString
"Created: / 12-04-2011 / 15:39:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableList::VariableEntry methodsFor:'accessing'!
application: anObject
application := anObject
"Created: / 12-04-2011 / 19:55:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
asString
^self name
"Created: / 11-07-2011 / 17:03:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
class:aClass
class := aClass.
!
icon
icon isNil ifTrue:[
icon := application iconInBrowserForVariable: name in: class.
icon isNil ifTrue:[icon := #NOICON].
].
^icon
"Created: / 12-04-2011 / 15:54:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 12-04-2011 / 19:58:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-11-2011 / 15:05:18 / cg"
!
klass
^ class
"Created: / 12-04-2011 / 19:54:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
label isNil ifTrue:[
label := name.
type notNil ifTrue:[
label := (label , ' ' , (type displayString colorizeAllWith: Color brown))
].
].
^label
"Created: / 16-12-2011 / 00:54:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
labelWithClass
|l|
l := self label.
class notNil ifTrue:[
^ label,' (' ,(class nameWithoutPrefix colorizeAllWith: Color grey),')'
].
^label
!
name
^ name
!
name:aString
name := aString.
!
sortingByNameHolder:something
sortingByNameHolder := something.
!
string
^name
"Created: / 12-04-2011 / 15:45:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
type
"Return a SmallSense inferred type"
^ type
"Modified (format): / 16-12-2011 / 00:41:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
type:aSmallSenseType
"Sets a SmallSense inferred type"
type := aSmallSenseType.
"Modified (format): / 16-12-2011 / 00:41:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableList::VariableEntry methodsFor:'displaying'!
displayOn:aGC x:x y:y opaque: opaque
| icn shownLabel |
icn := self icon.
icn ~~ #NOICON ifTrue:[
icn displayOn:aGC x:x + 1 y:y - icn height.
].
shownLabel := sortingByNameHolder value
ifTrue:[ self labelWithClass ]
ifFalse: [ self label ].
shownLabel displayOn:aGC x:x + 20 y:y opaque: opaque
"Created: / 12-04-2011 / 15:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableList::VariableEntry methodsFor:'queries'!
widthOn:aGC
^20"space for icon, see displayOn:..."
+ (self label widthOn:aGC)
"Created: / 16-12-2011 / 01:04:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableList class methodsFor:'documentation'!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/Tools__VariableList.st,v 1.25 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
^ '$Changeset: <not expanded> $'
!
version_SVN
^ '$Id: Tools__VariableList.st 8083 2013-01-14 11:48:37Z vranyj1 $'
! !