--- a/Tools_VariableList.st Thu Jul 07 16:13:28 2011 +0200
+++ b/Tools_VariableList.st Thu Jul 07 16:13:39 2011 +0200
@@ -14,12 +14,20 @@
"{ NameSpace: Tools }"
BrowserList subclass:#VariableList
- instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName'
+ instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName
+ selectedVariableEntries showWarningAboutMissingEntryInXmlSpec'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers-New'
!
+Object subclass:#VariableEntry
+ instanceVariableNames:'application class name icon'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:VariableList
+!
+
!VariableList class methodsFor:'documentation'!
copyright
@@ -143,6 +151,27 @@
^ 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
@@ -328,30 +357,39 @@
"/ ^ self delayedUpdate:something with:aParameter from:changedObject.
changedObject == Smalltalk ifTrue:[
- something == #methodDictionary ifTrue:[
- ^ self
- ].
- something == #methodTrap ifTrue:[
- ^ self
- ].
- something == #methodInClass ifTrue:[
- ^ self
- ].
- something == #methodInClassRemoved ifTrue:[
- ^ self
- ].
- something == #classComment ifTrue:[
- ^ self.
- ].
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #methodTrap 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: / 20.11.2001 / 21:55:22 / cg"
+ "Modified: / 20-11-2001 / 21:55:22 / cg"
+ "Modified: / 12-04-2011 / 15:54:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableList methodsFor:'generators'!
@@ -409,6 +447,33 @@
"/ ^ classesByInheritance first
!
+iconInBrowserForVariable: name in: class
+
+
+ ^class iconInBrowserForVariableNamed: name
+
+ "Created: / 12-04-2011 / 19:58:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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]. "
+
+ ^VariableEntry application: self class: cls name: name
+
+ "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>"
+!
+
listOfVariables
|nameList numClasses classes class commonSubclass showingClassVars
sortByName|
@@ -442,14 +507,17 @@
showingClassVars ifTrue:[
self showingInheritedClassVars ifTrue:[
class theNonMetaclass withAllSuperclassesDo:[:cls|
- nameList addAll:(cls classVarNames)
+ nameList addAll:
+ (cls classVarNames collect:[:nm|self listEntryForClass: cls name: nm])
]
] ifFalse:[
- nameList addAll:(class classVarNames)
+ nameList addAll:
+ (class classVarNames collect:[:nm|self listEntryForClass: class name: nm])
]
] ifFalse:[
class withAllSuperclassesDo:[:cls|
- nameList addAll:(cls instVarNames)
+ nameList addAll:
+ (cls classVarNames collect:[:nm|self listEntryForClass: cls name: nm])
]
]
].
@@ -468,22 +536,23 @@
varNames := showingClassVars ifTrue:[ cls classVarNames ] ifFalse:[ cls instVarNames ].
varNames copy reverse do:[:varName|
- nameList addFirst:varName.
+ nameList addFirst: (self listEntryForClass: cls name: varName).
].
sortByName ifFalse:[
- nameList addFirst:'----- ' , cls nameInBrowser , ' -----'.
+ nameList addFirst:(("'----- ' , "cls nameInBrowser" , ' -----'") asText colorizeAllWith: Color gray).
]
].
].
].
(numClasses > 1 or:[sortByName]) ifTrue:[
- nameList sort.
+ nameList := nameList asSortedCollection:[:a :b|a name < b name].
].
^ nameList
- "Created: / 5.2.2000 / 13:42:11 / cg"
- "Modified: / 26.2.2000 / 01:05:36 / cg"
+ "Created: / 05-02-2000 / 13:42:11 / cg"
+ "Modified: / 26-02-2000 / 01:05:36 / cg"
+ "Modified: / 28-04-2011 / 13:18:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postBuildWith:aBuilder
@@ -504,43 +573,127 @@
!
selectionChangeAllowed:index
- ^ ((variableList value at:index) startsWith:'---') not.
+
+ | 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 selectedVariables.
- prevSelection := (selectedVariablesHolder value copy) ? #().
- variableList value:newList.
+ selectedVariablesHolder := self selectedVariables.
+ prevSelection := (selectedVariablesHolder value copy) ? #().
+ variableList value:newList.
+
+ newSelection := prevSelection select:[:item | newList includes:item].
- newSelection := prevSelection select:[:item | newList includes:item].
+ newSelection size > 0 ifTrue:[
+ "/ force change (for dependents)
+ selectedVariablesHolder value:nil.
+ selectedVariablesHolder value:newSelection.
+ ] ifFalse:[
+ prevSelection := selectedVariablesHolder value.
+ selectedVariablesHolder value:nil.
+ ].
+ (prevSelection size > 0 or:[newSelection size > 0]) 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: / 12-04-2011 / 20:16:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!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
- newSelection size > 0 ifTrue:[
- "/ force change (for dependents)
- selectedVariablesHolder value:nil.
- selectedVariablesHolder value:newSelection.
- ] ifFalse:[
- prevSelection := selectedVariablesHolder value.
- selectedVariablesHolder value:nil.
- ].
- (prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[
- self updateOutputGenerator.
- ].
+ application := anObject
+
+ "Created: / 12-04-2011 / 19:55:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+class:aClass
+ class := aClass.
+!
+
+icon
+
+ icon ifNil:[icon := application iconInBrowserForVariable: name in: class].
+ icon ifNil:[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>"
+!
+
+klass
+ ^ class
+
+ "Created: / 12-04-2011 / 19:54:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+name
+ ^ name
+!
+
+name:aString
+ name := aString.
+!
+
+string
+
+ ^name
+
+ "Created: / 12-04-2011 / 15:45:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!VariableList::VariableEntry methodsFor:'displaying'!
+
+displayOn:aGC x:x y:y opaque: opaque
+
+ | icn |
+ icn := self icon.
+ icn ~~ #NOICON ifTrue:[
+ icn displayOn:aGC x:x + 1 y:y - icn height.
].
- listValid := true.
+ ^name displayOn:aGC x:x + 20 y:y opaque: opaque
+
+ "Created: / 12-04-2011 / 15:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableList class methodsFor:'documentation'!
-version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/Tools_VariableList.st,v 1.5 2010-05-07 12:27:20 cg Exp $'
-!
-
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Attic/Tools_VariableList.st,v 1.5 2010-05-07 12:27:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/Tools_VariableList.st,v 1.6 2011-07-07 14:13:39 vrany Exp $'
! !
--- a/Tools__VariableList.st Thu Jul 07 16:13:28 2011 +0200
+++ b/Tools__VariableList.st Thu Jul 07 16:13:39 2011 +0200
@@ -14,12 +14,20 @@
"{ NameSpace: Tools }"
BrowserList subclass:#VariableList
- instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName'
+ instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName
+ selectedVariableEntries showWarningAboutMissingEntryInXmlSpec'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers-New'
!
+Object subclass:#VariableEntry
+ instanceVariableNames:'application class name icon'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:VariableList
+!
+
!VariableList class methodsFor:'documentation'!
copyright
@@ -143,6 +151,27 @@
^ 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
@@ -328,30 +357,39 @@
"/ ^ self delayedUpdate:something with:aParameter from:changedObject.
changedObject == Smalltalk ifTrue:[
- something == #methodDictionary ifTrue:[
- ^ self
- ].
- something == #methodTrap ifTrue:[
- ^ self
- ].
- something == #methodInClass ifTrue:[
- ^ self
- ].
- something == #methodInClassRemoved ifTrue:[
- ^ self
- ].
- something == #classComment ifTrue:[
- ^ self.
- ].
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #methodTrap 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: / 20.11.2001 / 21:55:22 / cg"
+ "Modified: / 20-11-2001 / 21:55:22 / cg"
+ "Modified: / 12-04-2011 / 15:54:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableList methodsFor:'generators'!
@@ -409,6 +447,33 @@
"/ ^ classesByInheritance first
!
+iconInBrowserForVariable: name in: class
+
+
+ ^class iconInBrowserForVariableNamed: name
+
+ "Created: / 12-04-2011 / 19:58:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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]. "
+
+ ^VariableEntry application: self class: cls name: name
+
+ "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>"
+!
+
listOfVariables
|nameList numClasses classes class commonSubclass showingClassVars
sortByName|
@@ -442,14 +507,17 @@
showingClassVars ifTrue:[
self showingInheritedClassVars ifTrue:[
class theNonMetaclass withAllSuperclassesDo:[:cls|
- nameList addAll:(cls classVarNames)
+ nameList addAll:
+ (cls classVarNames collect:[:nm|self listEntryForClass: cls name: nm])
]
] ifFalse:[
- nameList addAll:(class classVarNames)
+ nameList addAll:
+ (class classVarNames collect:[:nm|self listEntryForClass: class name: nm])
]
] ifFalse:[
class withAllSuperclassesDo:[:cls|
- nameList addAll:(cls instVarNames)
+ nameList addAll:
+ (cls classVarNames collect:[:nm|self listEntryForClass: cls name: nm])
]
]
].
@@ -468,22 +536,23 @@
varNames := showingClassVars ifTrue:[ cls classVarNames ] ifFalse:[ cls instVarNames ].
varNames copy reverse do:[:varName|
- nameList addFirst:varName.
+ nameList addFirst: (self listEntryForClass: cls name: varName).
].
sortByName ifFalse:[
- nameList addFirst:'----- ' , cls nameInBrowser , ' -----'.
+ nameList addFirst:(("'----- ' , "cls nameInBrowser" , ' -----'") asText colorizeAllWith: Color gray).
]
].
].
].
(numClasses > 1 or:[sortByName]) ifTrue:[
- nameList sort.
+ nameList := nameList asSortedCollection:[:a :b|a name < b name].
].
^ nameList
- "Created: / 5.2.2000 / 13:42:11 / cg"
- "Modified: / 26.2.2000 / 01:05:36 / cg"
+ "Created: / 05-02-2000 / 13:42:11 / cg"
+ "Modified: / 26-02-2000 / 01:05:36 / cg"
+ "Modified: / 28-04-2011 / 13:18:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postBuildWith:aBuilder
@@ -504,43 +573,127 @@
!
selectionChangeAllowed:index
- ^ ((variableList value at:index) startsWith:'---') not.
+
+ | 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 selectedVariables.
- prevSelection := (selectedVariablesHolder value copy) ? #().
- variableList value:newList.
+ selectedVariablesHolder := self selectedVariables.
+ prevSelection := (selectedVariablesHolder value copy) ? #().
+ variableList value:newList.
+
+ newSelection := prevSelection select:[:item | newList includes:item].
- newSelection := prevSelection select:[:item | newList includes:item].
+ newSelection size > 0 ifTrue:[
+ "/ force change (for dependents)
+ selectedVariablesHolder value:nil.
+ selectedVariablesHolder value:newSelection.
+ ] ifFalse:[
+ prevSelection := selectedVariablesHolder value.
+ selectedVariablesHolder value:nil.
+ ].
+ (prevSelection size > 0 or:[newSelection size > 0]) 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: / 12-04-2011 / 20:16:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!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
- newSelection size > 0 ifTrue:[
- "/ force change (for dependents)
- selectedVariablesHolder value:nil.
- selectedVariablesHolder value:newSelection.
- ] ifFalse:[
- prevSelection := selectedVariablesHolder value.
- selectedVariablesHolder value:nil.
- ].
- (prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[
- self updateOutputGenerator.
- ].
+ application := anObject
+
+ "Created: / 12-04-2011 / 19:55:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+class:aClass
+ class := aClass.
+!
+
+icon
+
+ icon ifNil:[icon := application iconInBrowserForVariable: name in: class].
+ icon ifNil:[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>"
+!
+
+klass
+ ^ class
+
+ "Created: / 12-04-2011 / 19:54:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+name
+ ^ name
+!
+
+name:aString
+ name := aString.
+!
+
+string
+
+ ^name
+
+ "Created: / 12-04-2011 / 15:45:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!VariableList::VariableEntry methodsFor:'displaying'!
+
+displayOn:aGC x:x y:y opaque: opaque
+
+ | icn |
+ icn := self icon.
+ icn ~~ #NOICON ifTrue:[
+ icn displayOn:aGC x:x + 1 y:y - icn height.
].
- listValid := true.
+ ^name displayOn:aGC x:x + 20 y:y opaque: opaque
+
+ "Created: / 12-04-2011 / 15:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableList class methodsFor:'documentation'!
-version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__VariableList.st,v 1.5 2010-05-07 12:27:20 cg Exp $'
-!
-
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__VariableList.st,v 1.5 2010-05-07 12:27:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__VariableList.st,v 1.6 2011-07-07 14:13:39 vrany Exp $'
! !