--- a/ClassRevisionTree.st Fri Jan 14 11:51:20 2000 +0100
+++ b/ClassRevisionTree.st Fri Jan 14 11:51:42 2000 +0100
@@ -1,6 +1,7 @@
ApplicationModel subclass:#ClassRevisionTree
- instanceVariableNames:'selectionHolder semaphoreCritical revisionInfoList revisionTask
- currentClassItemInTask'
+ instanceVariableNames:'selectionHolder classHolder menuBlock selectionBlock
+ classItemClass listView semaphoreCritical revisionInfoList
+ revisionTask currentClassItemInTask'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers'
@@ -33,7 +34,7 @@
#name: 'ClassVersionTree'
#min: #(#Point 10 10)
#max: #(#Point 9999 9999)
- #bounds: #(#Rectangle 16 51 881 580)
+ #bounds: #(#Rectangle 16 46 881 575)
)
#component:
#(#SpecCollection
@@ -41,15 +42,15 @@
#(#HierarchicalListViewSpec
#name: 'HierarchicalItemListView'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #model: #hierarchicalItemSelectionAspect
- #menu: #selectHierarchicalItemMenu
+ #menu: #selectItemMenu
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
- #listModel: #hierarchicalItemListModel
+ #listModel: #listModel
#multipleSelectOk: true
+ #useIndex: false
#highlightMode: #label
#doubleClickSelector: #doubleClick:
- #selectConditionSelector: #isHierarchicalItemSelectable:
+ #selectConditionSelector: #isItemSelectable:
#indicatorSelector: #doubleClick:
#retrieveIconsSelector: #icons
)
@@ -59,84 +60,114 @@
)
! !
-!ClassRevisionTree class methodsFor:'menu specs'!
-
-resourceItemMenu
- "This resource specification was automatically generated
- by the MenuEditor of ST/X."
+!ClassRevisionTree class methodsFor:'protocol'!
- "Do not manually edit this!! If it is corrupted,
- the MenuEditor may not be able to read the specification."
-
- "
- MenuEditor new openOnClass:ClassRevisionTree andSelector:#resourceItemMenu
- (Menu new fromLiteralArrayEncoding:(ClassRevisionTree resourceItemMenu)) startUp
- "
+classItemClass
- <resource: #menu>
+ ^ClassItem
+!
- ^
- #(#Menu
- #(
- #(#MenuItem
- #label: 'Compare Changes'
- #translateLabel: true
- #value: #menuActionCompareChanges
- )
- )
- nil
- nil
- )
+classItemRootClass
+
+ ^ClassItemRoot
! !
!ClassRevisionTree class methodsFor:'startup'!
-openOnClasses:aClassColl withSelectionHolder:aValueHolder
- |theTree theClassItemColl|
+openOnClassHolder:aClassHolder
+
+ |theTree|
theTree := self new.
theTree allButOpen.
- theClassItemColl := aClassColl collect:[:eachClass |
- |theClassItem theClass|
- theClassItem := ClassItem new.
- theClass := Smalltalk resolveName:eachClass inClass:self.
- theClassItem myClass:theClass.
- theClassItem].
- theTree hierarchicalItemList addAll: theClassItemColl.
- theTree selectionHolder:aValueHolder.
- theTree openWindow.
+ theTree classHolder:aClassHolder.
+ theTree openWindow.
^theTree
"
-|theSelectionHolder|
+|theSelectionHolder theClassHolder theTree|
theSelectionHolder := ValueHolder new.
-theSelectionHolder compute:[:el |
- Transcript showCR: el first revisionString.
- Transcript showCR: el second revisionString].
-ClassRevisionTree openOnClasses:(Smalltalk allClasses asOrderedCollection sort:[:x : y|x name < y name])
- withSelectionHolder:theSelectionHolder.
+theClassHolder := ValueHolder new.
+theSelectionHolder compute:[:coll |
+ coll do:[:each | Transcript showCR: each]].
+theClassHolder value:(Smalltalk allClasses asOrderedCollection sort:[:x : y|x name < y name]).
+theTree := ClassRevisionTree openOnClassHolder:theClassHolder.
+theSelectionHolder value:(Array with:(theTree itemList children last)).
+theTree selectionHolder:theSelectionHolder.
+Delay waitForMilliseconds:1500.
+theClassHolder value:(Project current changedClasses).
+Delay waitForMilliseconds:1500.
+theTree classHolder:nil.
+Delay waitForMilliseconds:1500.
+theTree classHolder:theClassHolder.
+Delay waitForMilliseconds:1500.
+theClassHolder value:(Smalltalk allClasses asOrderedCollection sort:[:x : y|x name < y name]).
"
+!
+
+openOnClasses:aClassColl
+
+ |theTree|
+
+ theTree := self new.
+ theTree allButOpen.
+ theTree classHolder value:aClassColl.
+ theTree openWindow.
+ ^theTree
+
+"
+|theSelectionHolder theTree|
+
+theSelectionHolder := ValueHolder new.
+theSelectionHolder compute:[:coll |
+ coll do:[:each | Transcript showCR: each]].
+theTree := ClassRevisionTree openOnClasses:(Smalltalk allClasses asOrderedCollection sort:[:x : y|x name < y name]).
+theSelectionHolder value:(Array with:(theTree itemList children last)).
+theTree selectionHolder:theSelectionHolder.
+"
! !
!ClassRevisionTree methodsFor:'accessing'!
-hierarchicalListItemForSelectionIndex: anIndex
-""
- ^self hierarchicalItemListModel at:anIndex ifAbsent:nil
+classItemClass
+ "return the value of the instance variable 'classItemClass' (automatically generated)"
+
+ ^ classItemClass ifNil:[classItemClass := self class classItemClass]
+!
+
+classItemClass:something
+ "set the value of the instance variable 'classItemClass' (automatically generated)"
+
+ classItemClass := something.!
+
+classItemRootClass
+ "return the value of the instance variable 'classItemClass' (automatically generated)"
+
+ ^ self class classItemRootClass
!
-hierarchicalListSelectionIndexColl
-
- ^self hierarchicalItemSelectionAspect value
+itemForSelectionIndex:anIndex
+""
+ ^self listModel at:anIndex ifAbsent:nil
!
-hierarchicalListSelectionIndexColl:anArray
+itemList
+ "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."
- ^self hierarchicalItemSelectionAspect value:anArray
+ ^ self listModel root
+
+
+
+
+
!
revisionInfoList
@@ -145,17 +176,6 @@
^ revisionInfoList ifNil:[revisionInfoList := IdentitySet new]
!
-selectionHolder
- "return the value of the instance variable 'selectionHolder' (automatically generated)"
-
- ^ selectionHolder!
-
-selectionHolder:something
- "set the value of the instance variable 'revisionItemSelection' (automatically generated)"
-
- selectionHolder := something.
-!
-
semaphoreCritical
"return the value of the instance variable 'semaphoreCritical' (automatically generated)"
@@ -164,16 +184,13 @@
!ClassRevisionTree methodsFor:'actions'!
-doubleClick: anIndex
- "automatically generated by UIPainter ..."
+doubleClick:anIndex
+
+ |theItem|
- "*** the code below performs no action"
- "*** (except for some feedback on the Transcript)"
- "*** Please change as required and accept in the browser."
-
- "action to be added ..."
-
- (self hierarchicalItemListModel at: anIndex) toggleExpand
+ (((theItem := self itemForSelectionIndex:anIndex) isExpandableRevisionItem) and:[listView sensor shiftDown])
+ ifTrue: [theItem recursiveToggleExpand]
+ ifFalse:[theItem toggleExpand]
!
getRevisionInfoForClassItem: aClassItem
@@ -183,81 +200,37 @@
currentClassItemInTask == aClassItem ifTrue:[^self].
(theList := self revisionInfoList) removeIdentical:aClassItem ifAbsent:[nil].
theList add:aClassItem.
- Transcript showCR:theList.
self startRevisionTask]
!
-isHierarchicalItemSelectable: anIndex
-
- |theSelectionIndexColl theSelectionIndexSize theSelectedItem|
+isItemSelectable:anIndex
+"
+checks if an item at anIndex can be selected. If an selection block
+is set, evaluate it with the selected item.
+(Callback from the tree).
- "nur eine Revision kann selektiert werden"
- (theSelectedItem := self hierarchicalListItemForSelectionIndex: anIndex) isRevisionItem
- ifFalse:[^false].
- "ist keine selektiert ist alles ok -> mit true zurueck"
- (theSelectionIndexColl := self hierarchicalListSelectionIndexColl) size == 0
- ifTrue:[^true].
- "wurde deselektiert"
- (self window sensor ctrlDown)
- ifTrue: [
- "ist eine Rev selektiert und die Klassen sind nicht gleich, dann falsch"
- (self hierarchicalListItemForSelectionIndex:theSelectionIndexColl first) parent myClass == theSelectedItem parent myClass
- ifFalse:[^false].
- theSelectionIndexColl size ~~ 2
- ifTrue:[^true].
- (theSelectionIndexColl includes:anIndex)
- ifTrue: [^true]
- ifFalse:[self hierarchicalListSelectionIndexColl:(Array with:theSelectionIndexColl first).
- ^true]]
- ifFalse:[
- (theSelectionIndexColl size == 2)
- ifTrue:[self hierarchicalListSelectionIndexColl:(Array with:anIndex)].
- ^true]
-!
+<return: Boolean>
+"
+ selectionBlock ifNil:[^true].
+ ^selectionBlock value:(self itemForSelectionIndex:anIndex)
-menuActionCompareChanges
-
- |theSelectionIndexColl theFirstRevisionItem theSecondRevisionItem|
-
- theSelectionIndexColl := self hierarchicalListSelectionIndexColl.
- theFirstRevisionItem := self hierarchicalListItemForSelectionIndex:theSelectionIndexColl first.
- theSecondRevisionItem := self hierarchicalListItemForSelectionIndex:theSelectionIndexColl last.
- self selectionHolder notNil
- ifTrue:[self selectionHolder value:(Array with:theFirstRevisionItem with:theSecondRevisionItem)]
-!
-
-selectHierarchicalItemMenu
-"
-<return: Block>
-"
-
- ^[|menu|
- self checkIfTwoResourceItemsSelected
- ifFalse:[menu := nil]
- ifTrue: [menu := Menu new fromLiteralArrayEncoding:(self class resourceItemMenu).
- menu receiver:self].
- menu
- ]
! !
!ClassRevisionTree methodsFor:'aspects'!
-hierarchicalItemList
- "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."
+icons
+ |icons|
- ^ self hierarchicalItemListModel root
-
-
-
-
-
+ icons := Dictionary new.
+ icons at:#loadedRevision put:(Image fromFile:'gifImages/artwork/dots/red_ball.gif').
+ icons at:#unloadedRevision put:(Image fromFile:'gifImages/artwork/dots/green_ball.gif').
+ icons at:#unloadedClassItem put:(Image fromFile:'xpmBitmaps/file_images/small_folder_yellow_grey1.xpm').
+ icons at:#loadingClassItem put:(Image fromFile:'xpmBitmaps/file_images/small_folder_yellow_search.xpm').
+ icons at:#loadedClassItem put:(Image fromFile:'xpmBitmaps/file_images/small_folder_yellow.xpm').
+ ^icons
!
-hierarchicalItemListModel
+listModel
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
@@ -266,51 +239,41 @@
|holder|
- (holder := builder bindingAt:#hierarchicalItemListModel) isNil ifTrue:[
- holder := HierarchicalList new.
- holder root:(ClassItemRoot new).
- holder showRoot:false.
- builder aspectAt:#hierarchicalItemListModel put:holder.
- holder application:self.
- ].
-
- ^ holder.
-
-!
-
-hierarchicalItemSelectionAspect
- "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."
-
- |holder|
-
- (holder := builder bindingAt:#hierarchicalItemSelectionAspect) isNil ifTrue:[
- holder := ValueHolder new.
- builder aspectAt:#hierarchicalItemSelectionAspect put:holder.
- holder addDependent: self.
+ (holder := builder bindingAt:#listModel) isNil ifTrue:[
+ holder := HierarchicalList new.
+ holder root:(self classItemRootClass new).
+ holder showRoot:false.
+ builder aspectAt:#listModel put:holder.
+ holder application:self.
].
^ holder.
+! !
-!
+!ClassRevisionTree methodsFor:'change & update'!
-icons
- |icons|
- icons := Dictionary new.
- icons at:#loadedRevision put:Icon leftIcon.
- icons at:#notLoadedRevision put:Icon rightIcon.
- ^icons
+update:something with:aParameter from:changedObject
+
+ changedObject == self classHolder
+ ifTrue:[self setUpItemList].
+
+
! !
!ClassRevisionTree methodsFor:'interface opening'!
+postBuildWith: aBuilder
+
+ super postBuildWith: aBuilder.
+ listView := self builder componentAt:#HierarchicalItemListView.
+ selectionHolder notNil
+ ifTrue:[listView model:selectionHolder]
+!
+
postOpenWith: aBuilder
super postOpenWith: aBuilder.
- self hierarchicalItemList expand.
+ self itemList expand.
!
release
@@ -321,23 +284,19 @@
! !
-!ClassRevisionTree methodsFor:'private'!
-
-computeChildrenForClassItem:aClassItem
+!ClassRevisionTree methodsFor:'menu actions'!
- |theRevisionLog|
- theRevisionLog := self computeRevisionInfoForClassItem:aClassItem.
- aClassItem setChildrensForRevisionInfo:theRevisionLog
-!
+selectItemMenu
+"
+get the menu for the selected items.If a menuBlock is set then evalute this block
+with the current selection.
-computeRevisionInfoForClassItem:aClassItem
-
- |theClass theSourceCodeManager|
+<return: Menu|nil>
+"
+ ^ [ menuBlock value ]
+! !
- theClass := aClassItem myClass.
- theSourceCodeManager:=theClass sourceCodeManager.
- ^theSourceCodeManager revisionLogOf:theClass.
-!
+!ClassRevisionTree methodsFor:'private'!
revisionTaskCycle
@@ -349,16 +308,32 @@
self revisionInfoList notEmpty
ifTrue:[theClassItem := self revisionInfoList remove:(self revisionInfoList last) ifAbsent:[nil]]
].
- theClassItem notNil ifTrue:[
- theClassItem isExpanded
- ifTrue: [currentClassItemInTask:=theClassItem.
- self computeChildrenForClassItem:theClassItem]
- ifFalse:[currentClassItemInTask:=nil]
+ (theClassItem notNil and:[theClassItem needsChildren])ifTrue:[
+ currentClassItemInTask:=theClassItem.
+ theClassItem computeRevisions.
+ currentClassItemInTask:=nil
].
theClassItem notNil
] whileTrue.
!
+setUpItemList
+
+ |theClassColl theClassItemColl root|
+
+ root := self classItemRootClass new.
+ (theClassColl := self classHolder value) notNil ifTrue:[
+ theClassItemColl := theClassColl collect:[:eachClass |
+ |theClassItem theClass|
+ theClassItem := self classItemClass new.
+ theClass := Smalltalk resolveName:eachClass inClass:Smalltalk.
+ theClassItem myClass:theClass.
+ theClassItem].
+ root addAll: theClassItemColl.
+ ].
+ self listModel root:root.
+!
+
startRevisionTask
self semaphoreCritical critical:[
@@ -388,45 +363,80 @@
! !
-!ClassRevisionTree methodsFor:'setup'!
+!ClassRevisionTree methodsFor:'protocol accessing'!
+
+classHolder
+ "return the value of the instance variable 'classHolder' (automatically generated)"
+
+ ^classHolder ifNil:[
+ classHolder := ValueHolder new.
+ classHolder addDependent:self
+ ]
+!
+
+classHolder:aValueHolder
+ "set the value of the instance variable 'classHolder' (automatically generated)"
-setupOnClasses:aClassColl withSelectionHolder:aValueHolder
+ (classHolder ~~ aValueHolder) ifTrue:[
+ classHolder removeDependent:self.
+ classHolder := aValueHolder.
+ classHolder notNil ifTrue:[
+ classHolder addDependent:self.
+ ].
+ self setUpItemList
+ ].
+!
- |theClassItemColl|
+menuBlock
+ "return the value of the instance variable 'menuBlock' (automatically generated)"
+
+ ^ menuBlock
+!
- theClassItemColl := aClassColl collect:[:eachClass |
- |theClassItem theClass|
- theClassItem := ClassItem new.
- theClass := Smalltalk resolveName:eachClass inClass:Smalltalk.
- theClassItem myClass:theClass.
- theClassItem].
- self hierarchicalItemList addAll: theClassItemColl.
- self selectionHolder:aValueHolder.
+menuBlock:something
+ "set the value of the instance variable 'menuBlock' (automatically generated)"
+
+ menuBlock := something.!
+
+selectionBlock
+ "return the value of the instance variable 'selectionBlock' (automatically generated)"
+
+ ^ selectionBlock!
+
+selectionBlock:something
+ "set the value of the instance variable 'selectionBlock' (automatically generated)"
+
+ selectionBlock := something.!
+
+selectionHolder
+ ^selectionHolder
+!
+
+selectionHolder:aValueHolder
+ "set the value of the instance variable 'revisionItemSelection' (automatically generated)"
+
+ selectionHolder := aValueHolder.
+ listView ifNil:[^self].
+ listView model:selectionHolder
+! !
+
+!ClassRevisionTree methodsFor:'protocol setup'!
+
+setupOnClasses:aClassColl
+
+ self classHolder value:aClassColl.
"
|theTree|
theTree := ClassRevisionTree new.
theTree open.
-theTree setupOnClasses:#(VersionDiffBrowser HierarchicalVersionDiffBrowser SourceRevisionItem Project) withSelectionHolder:nil.
+theTree setupOnClasses:#(VersionDiffBrowser HierarchicalVersionDiffBrowser SourceRevisionItem Project)
"
! !
-!ClassRevisionTree methodsFor:'testing'!
-
-checkIfTwoResourceItemsSelected
-
- |theSelectionIndexColl|
-
- ((theSelectionIndexColl := self hierarchicalListSelectionIndexColl) isNil or:
- [theSelectionIndexColl size ~~ 2])
- ifTrue:[^false].
- ^((self hierarchicalListItemForSelectionIndex:theSelectionIndexColl first) isRevisionItem
- and:[(self hierarchicalListItemForSelectionIndex:theSelectionIndexColl last) isRevisionItem])
-! !
-
!ClassRevisionTree class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ClassRevisionTree.st,v 1.2 1999-12-29 15:37:57 ps Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ClassRevisionTree.st,v 1.3 2000-01-14 10:51:09 ps Exp $'
! !